263. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 11/9/2018 12:34:14 AM Central Standard Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.

263.1 Files compared

# Location File Last Modified
1 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHMXWBUT.m Mon Nov 5 16:43:16 2018 UTC
2 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHMXWBUT.m Mon Nov 5 17:53:55 2018 UTC

263.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 2 1706
Changed 1 2
Inserted 0 0
Removed 0 0

263.3 Comparison options

Whitespace
Character case Differences in character case are significant
Line endings Differences in line endings (CR and LF characters) are ignored
CR/LF characters Not shown in the comparison detail

263.4 Active regular expressions

No regular expressions were active.

263.5 Comparison detail

  1   CHMXWBUT         ;HRL /dlb;WEB 2 77 UTILITY  FUNCTIONS ;10/20/201 0 2:08 PM
  2           ;; 1;5010 MOD IFICATIONS ;;OCT 20,2 010;Build  1
  3           ;;  10/24/201 1  ADDED T HE GETDTE  START/END  DATE FUNCT ION TO UTI LITY ROUTI NE.
  4           ;;  11/1/2011     ADDED  "FMDUMP" F UNCTION FO R THE HC Q UALIFIER N ODES (^CHM XCLE(I,nn, J,0)
  5           ;;  11/3/2011   DLB        ADDED TH E "TEST" U TILITY THA T WILL DUM P THE CLAI M BUFFERS  FOR A
  6           ;;                                          PR OVIDED PDI .
  7           ;;  11/7/2011     DLB      ADDED TH E BUFFER D UMP FOR TH E ^CHMXCL( ) BATCH FI LE FOR THE  "TEST" UT ILITY
  8           ;;                                  WILL NOT M OVE INTO T EST/DEV UN TIL LATER  DATE
  9           ;;  11/7/2011     DLB      ADDED SA MPLE EXECU TABLE FUNC TIONS FOR  CREATING A  RECORD FR OM A $TEXT  DESCRIPTO R
  10           ;;                                  AND TO DOC UMENT THE  $TEXT DESC RIPTOR AUT OMATICALLY
  11           ;;  12/24/201 3  DLB MOD IFIED THE  GETDTE() F UNCTION TO  USE FILEM AN DATE EN TRY SO USE R CAN'T OM IT DATE EN TRY
  12           ;
  13           ; 
  14           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;
  15           ;  TEST ENTRY  POINT FOR  THE VERIF ICATION OF  THE LINE  ITEM STATU S RECORDS.                  
  16           ;  PROVIDE TH E "I" VALU E                                                                                                                   
  17           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;
  18           ;D EF016554 -  modified  for new re ad and wri te functio ns -- DRW  01/30/14  
  19   TSTREJ(CHC LFI)
  20           N  IDX,JDX,CH CLEI,COUNT ,FMDATE,TI ME,DATESTA MP
  21           S  (IDX,JDX,C OUNT)=1
  22           D  NOW^%DTC
  23           S  FMDATE=%
  24           S  FMDATE=$$J USTIFY^CHM XWBUT(FMDA TE,14,0,"L ")
  25           S  TIME=$$JUS TIFY^CHMXW BUT($E(FMD ATE,9,14), 6,0,"L")
  26           S  DATESTAMP= ($E(FMDATE ,1,7)+1700 0000)_TIME  ; DATE/TI ME FILE CR EATED DOWN  TO SECOND
  27           K  CHRJARR
  28           W  !,"TEST RE J FOR ",CH CLFI
  29           S  CHCLEI=$G( ^CHMXCLF(C HCLFI,0))
  30           D  GLINRJRSN^ CHMXWBUT(C HCLFI)
  31           D  BLDSTC^CHM XWB21("CLM ")
  32           F  IDX=1:1 Q: $G(CHRJARR (IDX,JDX)) =""  D
  33           .F  JDX=1:1 Q :$G(CHRJAR R(IDX,JDX) )=""  D
  34           .. W !,"IDX:  ",IDX,"  J DX: ",JDX, " = ",$G(C HRJARR(IDX ,JDX))
  35           Q
  36           
  37   OFILE(DIRF ILE,OFILEM )            ;Perform s the FILE  Open func tion 
  38           ;  DIRFILE        Direct ory/Filena me to be O pened
  39           ;  OFILEM: Fi le open de scriptor ( N=NEW,R=RE AD,W=WRITE ,L=LOCK,et c.)       
  40           ;R ETURN: PAS S/FAIL Ind icator
  41           ;
  42           N  FLAG,TMPIO  
  43           O  DIRFILE:OF ILEM:5                                 ; Op en the fil e with ope nfile desc riptors
  44           S  FLAG=$TEST                                        ;         Find  out if suc cessful
  45           Q  FLAG                                                                ;Return  Pass/Fail                                 ; ;RETURN PA SS/FAIL        
  46   CLOSEFILE( DIRFILE)
  47           N  TMPIO S TM PIO=$IO
  48           C  DIRFILE 
  49           W  !,"CLOSED  ",DIRFILE, !
  50           Q
  51                    ;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;
  52           ;  SUPPORT FU NCTIONS FO R THE BLDA CK() FUNCT ION AND ON  DEMAND ST ATISTICS R EPORTING                                                                                        ;
  53           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  54           ;  ^CHMDIC(74 1201.32 FI LE IS THE  DEFINITION S FILE FOR  THE REJEC TS                                            ;
  55           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  56            
  57   GTRXRJRSN( CHCLAI)                                  ;  TRANSACTIO N BUFFER R EJECT REAS ONS
  58           N  RJRSN,CHJV AL
  59           Q: 'CHCLAI 
  60           S  CHJVAL=0
  61           I  $D(^CHMXCL A(CHCLAI,1 01,CHJVAL) ) D
  62           .F   S CHJVAL =$O(^CHMXC LA(CHCLAI, 101,CHJVAL )) Q:'CHJV AL  D
  63           .. S RJRSN=$P (^CHMXCLA( CHCLAI,101 ,CHJVAL,0) ,"^",1)
  64                    ..D  SORTRJ(RJR SN)
  65                    Q 
  66           
  67   GPRORJRSN( CHCLBI)                                  ;  PROVIDER B UFFER REJE CT REASONS
  68           N  RJRSN,CHJV AL
  69           Q: 'CHCLBI 
  70           S  CHJVAL=0
  71           I  $D(^CHMXCL B(CHCLBI,1 01,CHJVAL) ) D
  72           .F   S CHJVAL =$O(^CHMXC LB(CHCLBI, 101,CHJVAL )) Q:'CHJV AL  D
  73           .. S RJRSN=$P (^CHMXCLB( CHCLBI,101 ,CHJVAL,0) ,"^",1)
  74                    ..D  SORTRJ(RJR SN)
  75                    Q 
  76           
  77   GPATRJRSN( CHCLCI)                                  ;  PATIENT BU FFER REJEC T REASON
  78           N  RJRSN,CHJV AL
  79           Q: 'CHCLCI                                                                              
  80           S  CHJVAL=0
  81           I  $D(^CHMXCL C(CHCLCI,1 01,CHJVAL) ) D 
  82           .F   S CHJVAL =$O(^CHMXC LC(CHCLCI, 101,CHJVAL )) Q:'CHJV AL  D        
  83           .. S RJRSN=$P (^CHMXCLC( CHCLCI,101 ,CHJVAL,0) ,"^",1)                         
  84                    ..D  SORTRJ(RJR SN)                                                            
  85                    Q 
  86           
  87   GCLMRJRSN( CHCLEI)                          ; CLAIM BU FFER REJEC T REASON
  88           N  RJRSN,CHJV AL
  89           Q: 'CHCLEI                                                                              
  90                    S CH JVAL=0
  91                    I $D (^CHMXCLE( CHCLEI,101 ,CHJVAL)) 
  92                    .F   S CHJVAL=$ O(^CHMXCLE (CHCLEI,10 1,CHJVAL))  Q:'CHJVAL   D       
  93           .. S RJRSN=$P (^CHMXCLE( CHCLEI,101 ,CHJVAL,0) ,"^",1)                         
  94                    ..D  SORTRJ(RJR SN)                                                            
  95                    Q 
  96                    
  97   GLINRJRSN( CHCLFI)                          ; SERVICE  LINE BUFFE R REJECT R EASONS
  98           N  RJRSN,CHJV AL
  99           Q: 'CHCLFI
  100                    S CH JVAL=0
  101           I  $D(^CHMXCL F(CHCLFI,1 01,CHJVAL) ) D  
  102                    .F   S CHJVAL=$ O(^CHMXCLF (CHCLFI,10 1,CHJVAL))  Q:'CHJVAL   D       
  103           .. S RJRSN=$P (^CHMXCLF( CHCLFI,101 ,CHJVAL,0) ,"^",1)                 
  104                    ..D  SORTRJ(RJR SN)
  105                    Q 
  106           
  107           
  108   SORTRJ(RJR SN)            ; SORT /BUILD REJ ECT REASON  ARRAY
  109           ;        RJRS N   THE VA LUE TO BE  CHECKED/AD DED
  110           N  EXIT,TVAL, IDX,JDX,RE JCODES
  111           S  TVAL=0,EXI T=0,REJCOD ES=0
  112           F  IDX=1:1 S  TVAL=$G(CH RJARR(IDX) ) Q:((TVAL ="")!(EXIT =1))  D
  113           .I  TVAL=RJRS N S EXIT=1  
  114           I  'EXIT  D
  115           .S  CHRJARR(I DX)=RJRSN                                                ; SET TH E REJECT R EASON INDE X
  116           .S  CHRJARR(0 )=$G(CHRJA RR(0))+1                             ; INCR EMENT THE  COUNTER
  117           .F  JDX=1:1 Q :REJCODES= ""  D
  118           .. S REJCODES =$P($G(^CH MXDIC(7412 01.32,RJRS N,0)),"^", JDX+3)
  119           .. S CHRJARR( IDX,JDX)=R EJCODES
  120           Q 
  121           
  122   GETIS(BUF, INDEX)
  123           N  CHCLFI,CHC LEI,CHCLBI ,CHCLAI,CH CLI
  124           I  BUF="F"  W  !,"CHCLFI = ",INDEX   D
  125           .S  CHCLEI=$P ($G(^CHMXC LF(INDEX)) ,"^",1) W  !,"CHCLEI  = ",CHCLEI
  126           .S  CHCLCI=$P (^CHMXCLE( CHCLEI,0), "^",1) W ! ,"CHCLCI=  ",CHCLCI              ;TRAVERSE  BACK THROU GH BUFFER  FILES
  127           .S  CHCLBI=$P (^CHMXCLC( CHCLCI,0), "^",1) W ! ,"CHCLBI=  ",CHCLBI
  128           .S  CHCLAI=$P (^CHMXCLB( CHCLBI,0), "^",1) W ! ,"CHCLAI=  ",CHCLAI
  129           .S  CHCLI=$P( ^CHMXCLA(C HCLAI,0)," ^",1) W !, "CHCLI= ", CHCLI
  130           E   I BUF="E"  S CHCLFI= 0 F  S CHC LFI=$O(^CH MXCLF("B", CHCLEI,CHC LFI)) W !, "CHCLFI= " ,CHCLFI  D
  131           .W  !,"CHCLEI = ",CHCLEI
  132           .S  CHCLCI=$P (^CHMXCLE( CHCLEI,0), "^",1) W ! ,"CHCLCI=  ",CHCLCI              ;TRAVERSE  BACK THROU GH BUFFER  FILES
  133           .S  CHCLBI=$P (^CHMXCLC( CHCLCI,0), "^",1) W ! ,"CHCLBI=  ",CHCLBI
  134           .S  CHCLAI=$P (^CHMXCLB( CHCLBI,0), "^",1) W ! ,"CHCLAI=  ",CHCLAI
  135           .S  CHCLI=$P( ^CHMXCLA(C HCLAI,0)," ^",1) W !, "CHCLI= ", CHCLI
  136           E   I BUF="C"   D
  137            W  !,"CHCLCI = ",CHCLCI
  138           .S  CHCLBI=$P (^CHMXCLC( CHCLCI,0), "^",1) W ! ,"CHCLBI=  ",CHCLBI
  139           .S  CHCLAI=$P (^CHMXCLB( CHCLBI,0), "^",1) W ! ,"CHCLAI=  ",CHCLAI
  140           .S  CHCLI=$P( ^CHMXCLA(C HCLAI,0)," ^",1) W !, "CHCLI= ", CHCLI
  141           E   I BUF="B"  W !,"CHCL BI= ",CHCL CI
  142           .S  CHCLAI=$P (^CHMXCLB( CHCLBI,0), "^",1) W ! ,"CHCLAI=  ",CHCLAI
  143           .S  CHCLI=$P( ^CHMXCLA(C HCLAI,0)," ^",1) W !, "CHCLI= ", CHCLI
  144           Q
  145           
  146           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;
  147           ;  GETDTE THI S FUNCTION  PROMPTS T HE USER FO R START AN D END DATE S FOR A PR OCESS.           
  148           ;  THE ROUTIN E CHECKS T HE USER IN PUT FOR VA LID START  AND END DA TES PRIOR  TO RETURNI NG
  149           ;  THE VALUES  TO THE CA LLER.
  150           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;
  151           
  152   TESTDATES
  153           N  FROM,TO
  154           D  GETDTE(.FR OM,.TO)
  155           W  !,"FROM =  ",FROM,"    TO = ",TO
  156           Q
  157           
  158           
  159           G: $D(DFOUT)  END^CHMXIN 01                                                             
  160           ;
  161           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;
  162           ;  MODS 12/24 /2013 DLB   DATE INPU R NOW UTIL IZES THE F ILEMAN %DT  DATE INPU T FOR
  163           ;  GETTING TH E START/EN D DATES FR OM THE USE R.
  164           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;
  165           ;        
  166   GETDTE(FRO M,TO)
  167           ;        FROM     MODIFI ABLE VARIA BLE FOR TH E "FROM/ST ART" DATE
  168           ;        TO                MODIFIAB LE VARIABL E FOR THE  "TO/END" D ATE 
  169           N  TOSEC 
  170           S  U="^" 
  171           S: $D(DTIME)  TOSEC=DTIM E                                    ; IF D TIME WAS V ALID, SAVE  THE ORIGI NAL TIMEOU T VALUE
  172           S  DTIME=600                                                                    ; SET TIME OUT TO 10  MINUTES 
  173   SDATE
  174                    S FR OM=""
  175           W  !!,"Enter  the START  date:  ",!  S X=Y,%DT ="AEPT",DT (0)="-T" D  ^%DT G:Y= -1 SDATE
  176               S FROM=Y                                                                    ; SET THE  "FROM" RET URN VARIAB LE TO INPU T VALUE
  177               K %DT                                                                               ;  REQUIRED B Y FILEMAN
  178   EDATE   ;
  179                    W !! ,"Enter th e STOP dat e: ",! S X =Y,%DT="AE PT",%DT(0) ="-T" D ^% DT G:Y=-1  EDATE
  180                    S TO =Y                                                                        ;  SET THE "T O" RETURN  VARIABLE T O THE INPU T VALUE
  181                    K %D T                                                                         ;  REQUIRED B Y FILEMAN
  182                    I $D (TOSEC) S  DTIME=TOSE C                                  ; RESTOR E ORIGINAL  TIMEOUT V ALUE
  183                    E  K  DTIME
  184   GETEND  Q 
  185           
  186           
  187   DTCVRT(DAT E)
  188           N  EXTDATE
  189                    S EX TDATE=$E(D ATE,4,5)_" -"_$E(DATE ,6,7)_"-"_ ($E(DATE,1 ,3)+1700)
  190           Q  EXTDATE        
  191           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;
  192           ;  SUPPORT RO UTINES FOR  BLDSTC()  AND ON DEM AND STATIS TICS REPOR T                  ;
  193           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;
  194           
  195           
  196           
  197           ;* ********** ********** ********** ********** ********** ********** ********** ********** **;
  198           ;  SUPPORT Su broutines;   May be r eplaceable  with Exis ting or Ne w Librarie s                         ;
  199           ;* ********** ********** ********** ********** ********** ********** ********** ********** **;
  200           
  201                    ;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;
  202           ;  THIS FUNCT ION IS DES IGNED TO F ORMAT DATA  BASED ON  THE FOLLOW ING $TEXT  FORMAT:          ;
  203           ;                                                                                                                                                                                        ;
  204           ;  ";;FLD NAM E;TARGET;L ENGTH;JUST IFY;PADCHA R;DELIMITE R;DATA DES C;FLD STAR T;FLD USE"       ;
  205           ;                                                                                                                                                                                        ;
  206           ;  THE DEFINI TION OF TH E MEMBERS  OF THE FOR MAT STRING :                                                                 ;
  207           ;                                                                                                                                                                                        ;
  208           ;                 ;;                        TH IS CONVENT ION DIFFER ENTIATES T ABLE FROM  A COMMENT  FIELD                 ;
  209           ;                 FLD NA ME         STRING IDE NTIFYING T HE FIELD,  TYPICALLY  TAKEN FROM  SPEC.                  ;
  210           ;                 TARGET            THIS CAN B E A FIXED  VALUE OR A  FUNCTION  TO RETURN  THE VALUE               ;
  211           ;                 LENGTH            FIELD WIDT H SPECIFIE D (LONGER  VALUES ALW AYS TRUNCA TED)                    ;
  212           ;                 JUSTIF Y          SUPPORTS " L" (LEFT), "R" (RIGHT ), AND "C"  (CENTER)                                   ;
  213           ;                 PADCHA R          ANY PRINTA BLE CHARAC TER, OR NO  CHAR IF P ADDING NOT  DESIRED                ;
  214           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  215           
  216   FORMATDATA (STR)          ;Pulls  and Forma ts Data in  EMDEON SP ECIFIED FI ELDS
  217           ;        STR               $TEXT St ring descr ibing the  record 
  218           N  VALUE,TMPI O,COLWIDTH ,VAR,JUSTI FY,PAD,FIE LD,DELIM
  219           S  TMPIO=$IO, VALUE=""
  220           S  COLWIDTH=$ P(STR,";", 5),JUSTIFY =$P(STR,"; ",6)                             ; Get Colw idth & Jus tify value s
  221           S  FIELD=$P(S TR,";",3), PAD=$P(STR ,";",7)                                             ;  Get Field, PadChar
  222           S  VALUE="S V AR="_$P(ST R,";",4) X  VALUE                                              ;  VAR Now co ntains the  desired v alue
  223           S: FIELD="SEX " VAR=$S(V AR="M":"M" ,VAR="F":" F",1:"M")                        ; Default  SEX=M if U ndefined
  224           S  VALUE=$E($ $JUSTIFY(V AR,COLWIDT H,PAD,JUST IFY),1,COL WIDTH)       ; LEFT/R IGHT/CENTE R JUSTIFIC ATION
  225           Q  VALUE
  226           
  227           
  228           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;
  229           ;  JUSTIFY()    A multip urpose jus tification  function  that perfo rms Right/ Left/Cente r(LRC)         ;
  230           ;                            justif ication in  addition  to the tru ncation of  the speci fied strin g as                  ;
  231           ;                            requir ed to sati sfy the wi dth specif ication. A llows user  to specif y ANY                 ;
  232           ;                            "pad"  character  to be used  in the Ri ght/Left/C enter just ification.                       ;
  233           ;   NOTE: If  the length  of the pr ovided str ing is gre ater than  the specif ied width,  the           ;
  234           ;        retu rn value i s the trun cated stri ng to fit  into the s pecified w idth.                                       ;
  235           ;   NOTE2: Th e original  MUMPS $J  function h as some li mitations,  i.e. it p rovides R  and L          ;
  236           ;                 justif ication, b ut no "cen ter" in fi eld, and t here is a  problem wi th the mat h            ;
  237           ;                 in cal culating t he output  if the str ing length  and colum n width ar e the same .            ;
  238           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;
  239           
  240   JUSTIFY(ST R,COLWIDTH ,PAD,LRC)
  241           ;        STR                        Value to b e formatte d and outp ut
  242           ;        COLW IDTH         MAX Fiel d Width of  the strin g to be re turned
  243           ;        PAD                        Character  used to "p ad" the st ring (Must  be printa ble char f or justifi cation)
  244           ;        LRC                        Left/Right /Center Ju stify the  string in  the column  width
  245           ;R ETURN                   A String  ready for  output
  246           N  VARLEN,RET URN,PADSTR ,LPAD,PDCN T       S  (PADSTR,LP AD)=""
  247           S  VARLEN=$L( STR)                                                                                                 ; Get Le ngth of th e variable
  248           I  VARLEN=COL WIDTH S RE TURN=STR                                                                ; Sa me as Spec ified widt h
  249           E   I VARLEN> COLWIDTH S  RETURN=$E (STR,1,COL WIDTH)                           ; IF great er, discar d extra le ngth
  250           E   I (PAD="" ) S RETURN =$E(STR,1, COLWIDTH)                                           ;  Else IF PA D CHARACTE R NOT DEFI NED
  251           E   D                                                                                                                       ; justify  the variab le in the  string
  252           .I  LRC="C" S  PDCNT=((C OLWIDTH-VA RLEN/2)+(C OLWIDTH-VA RLEN#2)) D   ; Center  the Strin g in the w idth
  253           .. S $P(PADST R,PAD,PDCN T)=PAD,RET URN=(PADST R_STR_PADS TR)
  254           .. S RETURN=$ E(RETURN,1 ,COLWIDTH)
  255           .E   I LRC="L " D                                                      ; Left J ustify w/P ad Charact er
  256           .. S $P(PADST R,PAD,COLW IDTH)=PAD                    
  257               ..S RETUR N=$E(STR_P ADSTR,1,CO LWIDTH)
  258               .E  S $P( PADSTR,PAD ,(COLWIDTH -$L(STR)+1 ))="" D                          ; Right Ju stify w/Pa d Char
  259               ..S RETUR N=PADSTR_S TR                                                                                        
  260           Q  RETURN                                                                                                                   ; RETURN T HE FORMATT ED STRING
  261            
  262           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  263           ;  Right and  Left Justi fy functio ns courtes y of JBM 7 /2/2010                                                           ;
  264           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  265           
  266   LJ(STR,SIZ E,PAD1)        ;
  267                    N RE T,PAD
  268                    S PA D="",RET=" "
  269                    I PA D1="" S RE T=$E(STR,1 ,SIZE) 
  270                    E  S  $P(PAD,PA D1,SIZE)=P AD1,RET=$E (STR_PAD,1 ,SIZE) 
  271                    Q RE T
  272   RJ(STR,SIZ E,PAD1)        
  273                    N RE T,PAD
  274                    S PA D="",RET=" "
  275                    I PA D1="" S RE T=$E(STR,1 ,SIZE)
  276                    E  S  $P(PAD,PA D1,(SIZE-$ L(STR)+1)) ="",RET=$E (PAD_STR,1 ,SIZE)
  277                    Q RE T
  278                    
  279                    
  280                    
  281                    ;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;
  282                    ;        EMDEON HDR:       Common Hea der for EM DEON STATU S Files                                                                 ;
  283                    ;        A sing le header  is generat ed for eac h output f ile.                                                                    ;
  284                    ;     DESC: "FI ELD NAME"; "LENGTH";" JUSTIFY FL AG";"PAD C HAR";"DATA  TYPE";                            ;
  285                    ;                 FIELD NA ME:  EMDEO N File FIE LD DESCRIP TOR(record  # and tex t descript ion)         ;
  286                    ;                 LENGTH:   EMDEON FI LE SPECIFI ED FIELD W IDTH                                                                             ;
  287                    ;                 JUSTIFY  FLAG: L=LE FT, R=RIGH T, C= CENT ER                                                                               ;
  288                    ;                 PAD: PAD  CHARACTER  TO BE USE D TO FILL  FIELD WIDT H (ANY PRI NTABLE CHA RACTER)      ;
  289                    ;                          NOTE: PAD  CHAR="" IF  NO CHARAC TER IS BET WEEN THE S EMICOLONS  (I.E. ;;)    ;
  290                    ;                          NO PADDING  WILL OCCU R IF THIS  IS SET UP  THIS WAY                                                     ;
  291                    ;                 DATA PAT TERN: PATT ERN MATCH  DESCRIPTOR  DESCRIBIN G THE VALU E                                        ;
  292                    ;                 FIELD ST ART LOCATI ON: LOCATI ON IN RECO RD FOR THI S FIELD-DO CUMENTATIO N ONLY       ;
  293                    ;                 FIELD US E: R=REQUI RED, C=CON DITIONAL,  O=OPTIONAL                                                              ;
  294                    ;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;
  295                    ;                                                                                                                                                                                        ;
  296                    ; FO RMATDATA T REATS THE  PAD CHAR ( ;;) AS A N ULL, SO NO  PADDING O CCURS.                             ;
  297                    ; TH IS WILL AL LOW USE OF  THE FORMA TDATA FUNC TION WITHO UT MODIFIC ATION BETW EEN            ;
  298                    ; PA DDED AND N ON-PADDED  FIELDS.                                                                                                                    ;
  299                    ;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;
  300                    ; 8/ 4/11  DLB  "6. CREATI ON TIME" F ROM $E(DAT ESTAMP,9,1 2) TO $E(D ATESTAMP,9 ,14)           ;
  301                    ; 8/ 15/11 DLB  "2. FILE G ROUP ID" I NSERTED TH E DATESTAM P VALUE TO  ENSURE UN IQUENESS       ;
  302                    ; 9/ 7/2011 DLB  12. LOAD  TYPE CHANG ED TO PROV IDE "F" WH EN HISTORI CAL FILE G ENERATED       ;
  303                    ;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;
  304                    
  305   TSTHDR           ;BUI LD HEADER  RECORD
  306           N  LN,REC,STR ,LOADTYPE, DATESTAMP, GROUPID
  307           S  GROUPID=""
  308           S  (STR,LN,RE C)="",COUN T=2                         ; EM DEON SPEC:  REC. COUN T STARTS @  2
  309           S  DATESTAMP= $$FMDATE(" NOW")
  310           F  LN=1:1 S S TR=$T(SAMP LEHDR+LN)  Q:STR["END  OF RECORD "  D
  311           .I  LN=1 S RE C=REC_$$FO RMATDATA^C HMXWBUT(ST R)    
  312           .E   S REC=RE C_"|"_$$FO RMATDATA^C HMXWBUT(ST R)
  313           W  REC,! S RE C=""                                                             
  314           Q
  315                               
  316   SAMPLEHDR        ;"FI ELD NAME"; "TARGET VA LUE";"LENG TH";"JUSTI FY FLAG";" PAD CHAR"; DATA LENGT H/PATTERN" ;FIELD STA RT LOCATIO N;FIELD US E
  317                    ;;1. RECORD ID; "HDR";3;L; ;3AN;0;R;
  318                    ;;2. FILE GROUP  ID;$S(GRO UPID'="":G ROUPID,1:D ATESTAMP); 20;L;;20AN ;4;R;
  319                    ;;3. FILE GROUP  SEQUENCE  NUMBER;"FI LE NUMBER" ;2;R;0;3N; 24;R;
  320                    ;;4. FILE GROUP  COUNT;"GR OUP NUMBER ";2;R;0;3N ;26;R;
  321                    ;;5. CREATION D ATE;$E(DAT ESTAMP,1,7 );8;L;;8AN ;28;R;
  322                    ;;6. CREATION T IME;$E(DAT ESTAMP,9,1 4);6;L;;6N ;36;R;
  323                    ;;7. TRADING PA RTNER ID;" VAFNH";10; L;;10AN;42 ;R;
  324                    ;;8. SUBMITTER  NAME;"SUBM ITTER NAME ";30;L;;30 AN;53;R;
  325                    ;;9. PAYER CONT ACT NAME;" PAYER CONT ACT NAME"; 60;L;;60AN ;83;O;
  326                    ;;10 .PAYER SUP PORT TELEP HONE NUMBE R;"";10;L; ;10N;143;O ;
  327                    ;;11 .PAYER SUP PORT EMAIL  ADDRESS;" ";80;L;;80 AN;153;O;
  328                    ;;12 .LOAD TYPE ;"LOADTYPE ";1;L;;1AN ;233;R;
  329                    ;;13 .PAYER UNI QUE FILE I DENTIFIER; DATESTAMP; 20;L;;20AN ;234;R;
  330                    ;;14 .FILE TYPE ;"CStat";5 ;L;;5AN;25 4;R;
  331                    ;;15 .VERSION C ODE;"03";2 ;L;;2AN;25 8;R;
  332                    ;;16 .RELEASE C ODE;"00";2 ;L;;2AN;26 0;R;
  333                    ;;18 .END OF RE CORD;
  334                    
  335           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;
  336           ;  DOCUMENTRE C (UTILITY  THAT HELP S IN DOCUM ENTING THE  RECORD GE NERATION P ROCESS) ;
  337           ;  CREATES A  FILE THAT  CONTAINS T HE RECORD  INFORMATIO N FOR THE  5010                                 ;
  338           ;  EMDEON STA TUS RECORD S, INCLUDI NG THE HEA DER, CLAIM , LINE ITE M, AND TRA ILER    ;
  339           ;  RECORDS.   THIS FUNCT ION USES T HE FIELD D ESCRIPTORS  TO DOCUME NT EACH FI ELD IN  ;
  340           ;  THE RECORD S, I.E.:                                                                                                                                ;
  341           ;        1) R ECORD NAME                                                                                                                                       ;
  342           ;        2) S TARTING LO CATION IN  THE RECORD                                                                                               ;
  343           ;        3) L ENGTH (WID TH) OF THE  FIELD                                                                                                   ;
  344           ;        4) J USTIFICATI ON WITHIN  THE FIELD                                                                                                ;
  345           ;        5) T HE VALUE ( HARD CODED  FIELDS) O R THE CACH E FILELOCA TION FROM  WHICH THE        ;
  346           ;                 VALUE  IS RETRIEV ED.                                                                                                               ;
  347           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;
  348           
  349   DOCUMENTRE C
  350           N  DOCFILE,TM PIO,LN,HTA BS,FTABS,R TYPE,RNAME ,CHTYPE,ST R,COLNMS,D ATESTAMP
  351           S  DATESTAMP= $$FMDATE(" XDT")
  352           S  RTYPE="SAM PLEHDR"               ; NAMES OF  $TEXT TAB LES
  353           S  COLNMS="FI ELD NAME^U SE^DESC^PA D^JUST^VAL UE"            ; COLU MN HEADER  NAMES
  354           S  HTABS="35^ 39^45^50^5 7"                          ; HE ADER TAB S TOPS FOR T HE FIELD D ESCRIPTION S
  355           S  FTABS="36^ 39^46^52^5 7"                          ; FI ELD TAB ST OPS FOR DE SCRIPTIONS
  356           S  DOCPATH="S YS$LOGIN:"   
  357           S  DOCFILE="D OC277_5010 _"_DATESTA MP_".TXT"        ; ST ATUS MAPPI NG DOCUMEN TATION
  358           S  DOCFILE=DO CPATH_DOCF ILE                                           ; OUTPUT  THE $TEXT  TO A PRIN TABLE FILE
  359           W  !,"OUTPUT  FILE=",DOC FILE
  360           ;S  FLAG=$$OF ILE^CHMXWB UT(DOCFILE ,"NWS")
  361           S  FLAG=$$OPE NFIWR^CHTF LIB9(.DOCF ILE,"DOCFI LE") 
  362           S  TMPIO=$IO  U DOCFILE
  363           F  CHTYPE=1:1   S RNAME= $P(RTYPE," ^",CHTYPE)  Q:RNAME=" "  D
  364           .W  !!,?20,"H EALTH CARE  CLEARING  HOUSE """, RNAME,"""   RECORD DE FINITIONS"         ;  TITLE
  365           .W  !,$P(COLN MS,"^",1), ?$P(HTABS, "^",1),$P( COLNMS,"^" ,2),?$P(HT ABS,"^",2) ,$P(COLNMS ,"^",3),?$ P(HTABS,"^ ",3),$P(CO LNMS,"^",4 ),?$P(HTAB S,"^",4),$ P(COLNMS," ^",5),?$P( HTABS,"^", 5),$P(COLN MS,"^",6), ?$P(HTABS, "^",6),$P( COLNMS,"^" ,7)
  366           .F  LN=1:1 S  STR=$T(@RN AME+LN) Q: STR["END O F RECORD"   D           ; READ $ TEXT DESCR IPTOR
  367           .. W !,$P(STR ,";",3),?$ P(FTABS,"^ ",1),$P(ST R,";",10), ?$P(FTABS, "^",2),$P( STR,";",8) ,?$P(FTABS ,"^",3),$P (STR,";",7 ),?$P(FTAB S,"^",4),$ P(STR,";", 6),?$P(FTA BS,"^",5), $P(STR,";" ,4)
  368           U  TMPIO 
  369           ;D  CLOSEFILE ^CHMXWBUT( DOCFILE)                    ; CL OSE CURREN T FILE
  370           D  CLOSEF^CHT FLIB9(DOCF ILE,"DOCFI LE")
  371           Q
  372                   
  373           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  374           ;  EXTDATE(FM DT) Takes  the filema n date and  converts  it to YYYY MMDD forma t                         ;
  375           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;   
  376           
  377   EXTDATE(FM DT)
  378           ;        FMDT     The da te in file man format  CCYYMMDD  (seconds a re ignored  if sent)
  379           ;R ETURNS         the da te in EXTE RNAL (YYYY MMDD) form at  
  380                    Q:$G (FMDT)=""  ""
  381                    S FM DT=$E(FMDT ,1,7)
  382                    N X, %H,%Y,%T
  383                    S X= FMDT                                   ; X  Must be se t to Filem an Date St ring
  384                    D H^ %DTC                                   ; Co nvert File man to $H
  385                    Q $Z D(%H,8)                                ; Co nvert $H t o YYYYMMDD
  386           
  387           
  388   GETDATE(ST R)             ; USER  RESPONSE  FOR DATE I NPUT
  389           ;        STR      MESSAG E FOR THE  DATE YOU W ANT ENTERE D (I.E "EN TER START  DATE")
  390   A3      W  !! S %DT=" AEPX",%DT( "A")=STR D  ^%DT 
  391                    G:X= "^" ENDX G :X="^^" EN DX G:Y=-1  A3
  392   ENDX    Q  Y
  393           
  394           
  395           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  396                    ; FM DATE(WHEN)   Returns  ONLY the F ILEMAN for mat Date f rom the NO W^%DTC Fun ction          ; 
  397           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;; 
  398           
  399   FMDATE(WHE N)
  400           ;        WHEN : Currentl y the opti ons, "NOW" ,"TIME" ON LY,"XD:T"  EXTERNAL D ATE:TIME
  401           ;R ETURN: Dat e in Filem an Format
  402           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  403           ;O utput Vari ables for  the NOW^%D TC                                                                                                                ; 
  404           ;        %        VA Fil eMan date/ time down  to the sec ond.                                                                               ;
  405           ;        %H       $H dat e/time.                                                                                                                                        ;
  406           ;        %I(1 )   The nu meric valu e of the m onth.                                                                                         ;
  407           ;        %I(2 )   The nu meric valu e of the d ay.                                                                                           ;
  408           ;        %I(3 )   The nu meric valu e of the y ear.                                                                                          ;
  409           ;        X                 VA FileM an date on ly.                                                                                                             ;
  410           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  411           
  412           N  DATE,TIME, CHHMM
  413           D  NOW^%DTC
  414           S  CHDT=$E(%, 1,7),CHFMD TE=$E(%,4, 7)
  415               S CMMDD=$ E(%,4,7),C HHMMSS=$E( %,9,14),CH HMM=$E(%,9 ,12)
  416               I $L(CHHM MSS)<6 S C HHMMSS=CHH MMSS_"1111 11",CHHMMS S=$E(CHHMM SS,1,6)
  417           S  DATE=X,TIM E=CHHMMSS 
  418                    I WH EN="NOW"     Q %                                                          ;% = FILEMAN  DATE+TIME
  419                    I WH EN="DAY"     Q X                                                  ;X= FILEMA N YYMMDD
  420           I  WHEN="TIME "   S X=%  D H^%DTC Q  %T                       ; Retu rn the FM  format dat e:time
  421           I  WHEN="XDT"     Q $$FM TOYYYYMMDD (DATE)_CHH MM ; EXT.  DATE WITH  HOUR&MINUT E
  422           I  WHEN="DT"      Q:$E(% ,1,7)
  423           I  WHEN="FMD: T"  Q:$E(% ,4,7)
  424           I  WHEN="HMS6 "   Q:$E(% ,9,14)
  425           I  WHEN="YEST "   S X1=D ATE,X2=-1  D C^%DTC Q  X    ;YES TERDAY
  426           I  WHEN="TOM"     S X1=D ATE,X2=1 D  C^%DTC Q  X              ;TOMOR ROW
  427           I  WHEN="B1W"     S X1=D ATE,X2=-7  D C^%DTC Q  X    ;BAC K ONE WEEK
  428           I  WHEN="F1W"     S X1=D ATE,X2=7 D  C^%DTC Q  X              ;FORWA RD ONE WEE K       
  429                    Q 0                                                                                              ; 0 re turn for n on-specifi ed "when"      
  430                    
  431           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  432           ;  FMTOYYYYMM DD(FMDT) T akes the f ileman dat e and conv erts it to  yyyymmdd  format           ;
  433           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;   
  434           
  435   FMTOYYYYMM DD(FMDT)
  436           ;        FMDT     The da te in file man format  CCYYMMDD  (seconds a re ignored  if sent)
  437           ;R ETURN the  date in YY YYMMDD for mat     
  438                    Q:$G (FMDT)=""  ""
  439                    N X, %H,%Y,%T
  440                    S X= FMDT                                   ; X  Must be se t to Filem an Date St ring
  441                    D H^ %DTC                                   ; Co nvert File man to $H
  442                    Q $Z D(%H,8)                                ; Co nvert $H t o YYYYMMDD
  443                    
  444   FMTOHHMMSS (FMTIME)
  445           ;        FMTI ME  THE Fi leman time  to conver t to hhmms s format
  446           ;  RETURN: TH E CONVERTE D TIME
  447           N  X,%F,CT
  448           S  X=FMTIME,% F=0,CT=$$F MTH^XLFDT( X,%F)
  449   GETHHMMSS( CT)
  450                   N HT, ZT,HH,MM,S S
  451                   S HT= $P(CT,",", 2)
  452                   S ZT= $ZT(HT,1,9 )        
  453                   S HH= $P(ZT,":", 1)
  454                   S MM= $P(ZT,":", 2)
  455                   S SS= $P($P(ZT," :",3),".", 1)
  456                   Q HH_ MM_SS
  457           
  458           
  459           ;  FILEMAN PR OGRAMMER M ANUAL: 2.3 .64 S^%DTC : Date/Tim e Utility
  460           ;  This entry  takes the  number of  seconds f rom midnig ht and tur ns it 
  461           ;  into hours , minutes,  and secon ds as a de cimal part  of a VA F ileMan dat e.      
  462   FMSDTC(SEC ONDS)
  463           ;  SECONDS        THE EL APSED SECO NDS VALUE  SINCE MIDN IGHT
  464           S  %=SECONDS                                                                                     ; US ER SPECIFI ED NUMBER  OF SECONDS
  465           S: SECONDS'>0  %=$P($H," ,",2)                                                  ; NUMBER O F SECONDS  SINCE MIDN IGHT
  466           D  S^%DTC
  467           Q  %
  468           
  469           
  470           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  471           ;  BETWEEN TE STS A DATE  TO BE BET WEEN TWO O THER DATES .  I.E. GI VEN TWO DA TES, ;
  472           ;  "FROM" DAT E AND "TO"  DATE, THI S FUNCTION  RETURNS T RUE IF THE  USER DATE          ;
  473           ;  FALLS BETW EEN THE FR OM AND TO  DATES.                                                                                   ;
  474           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  475           
  476   DATECHK(TD ATE,FDATE, UDATE)
  477           ;        TDAT E                     THE "TO" B OUNDARY DA TE
  478           ;        FDAT E                     THE "FROM  BOUNDARY D ATE
  479           ;        UDAT E                     THE USER D ATE TO BE  TESTED
  480           I  UDATE>TDAT E Q 0                 ;FAIL IF T HE USER DA TE MORE RE CENT THAN  THE "TO" B OUNDARY
  481           I  UDATE'>FDA TE Q -1               ; FAIL IF  USER DATE  IS BEFORE/ EQUAL TO " FROM" BOUN DARY
  482           Q  1
  483           
  484           
  485           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  486           ;  UTILITY FU NCTION WRI TTEN TO DU MP A ^CHMX CLE(I,nnn, J,0) NODE.
  487           ;  WHERE I IS  THE CLAIM  INDEX INT O THE ^CHM XCLE FILE
  488           ;                 nnn IS  THE NODE  NUMBER (i. e. 39, 40,  41, ETC)
  489           ;                 J IS T HE "J" IND EX FOR THE  FILEMAN M ULTIPLE (D UMPS ALL " J" NODES)
  490           ;                 "0" IS  THE ASSUM ED VALUE F OR THE LEA ST SIGNIFI CANT NODE  ADDRESS
  491           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  492           ;  EXAMPLE OU TPUT 
  493           ;  (NOTE: ONL Y POPULATE D FIELDS A RE OUTPUT  BY FILEMAN  FUNCTION)
  494           ;
  495           ;  DUMP NODE:  ^CHMXCLE( 10962425,3 9,1,0)
  496           ;
  497           ;  HC CODE QU ALIFIER #1 : BK                  HC CODE #1 : 338.29
  498           ;  HC CODE AM OUNT #1: 0                    HC  CODE AMOU NT #2: 0
  499           ;  HC CODE AM OUNT #3: 0                    HC  CODE AMOU NT #4: 0
  500           ;  HC CODE QT Y #1: 0                       HC  CODE QTY  #2: 0
  501           ;  HC CODE QT Y #3: 0                       HC  CODE QTY  #4: 0
  502           ;
  503           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  504           
  505   TSTFMDUMP        ; EX AMPLE FOR  USING THE  FMDUMP FUN CTION
  506           N  INDEX S I= 10962425
  507           N  NVAL S N=3 9
  508           D  FMDUMP(IND EX,NVAL)
  509           Q
  510           
  511   FMDUMP(IVA L,NODE)
  512           ;        IVAL     CLAIM  INDEX FOR  ^CHMXCLE(I )
  513           ;        NODE     NODE N UMBER (39, 40,ETC.)
  514           N  JVAL,NODE1   S JVAL=0
  515           F   S JVAL=$O (^CHMXCLE( IVAL,NODE, JVAL))  Q: JVAL'?1N.N   D
  516           .W  !,"DUMP N ODE: ^CHMX CLE(",IVAL ,",",NODE, ",",JVAL," ,0)",!!
  517           .S  DA(1)=IVA L,DA=JVAL 
  518           .S  DIC="^CHM XCLE"_"("_ IVAL_","_N ODE_","  
  519           .D  EN^DIQ
  520           Q        
  521           
  522           
  523           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  524           ;  THE FOLLOW ING FUNCTI ON TAKES T HE USER PR OVIDED PDI , EXTRACTS  THE BUFFE R
  525           ;  INDEXES FO R THE CLAI M BUFFERS,  THEN MAKE S A CALL T O FILEMAN  TO DUMP TH E
  526           ;  CONTENTS F OR EACH OF  THE CLAIM  BUFFERS:  ^CHMXCLA(8 37 TRANSAC TION, ^CHM XCLB(
  527           ;  PROVIDER,  ^CHMXCLC(P ATIENT, ^C HMXCLE(CLA IM, AND ^C HMXCLF(LIN E ITEM. 
  528           ;  THIS SHOUL D BE A USE FUL TOOL F OR QA AND  PST WHEN T ESTING/VER IFYING DAT A
  529           ;  FOR DAY TO  DAY OPERA TIONS.
  530           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  531           
  532   TEST
  533           N  ANS,CHREFN ,CHPCN,CHM XCLI,CHMXI D,CHAI,CHB TCH,CHBI,C HCI,CHEI,C HFI 
  534           W  !!,"Enter  REFERENCE  (PDI) NUMB ER:  " D S BRS
  535           Q: $D(DUOUT)   Q:$D(DFOU T)
  536           I  Y=" ",$D(^ DISV(DUZ," REFNO")) S  ANS=$P(^D ISV(DUZ,"R EFNO"),"^" ,1) W ANS  S CHREFN=A NS S CHPCN ="" G TEST
  537           I  $D(DQOUT)  D HLP2 G T EST
  538           Q: Y=""  I Y= " ",'$D(^D ISV(DUZ,"R EFNO")) W  "No defaul t Referenc e Number."
  539           I  Y'?15N D H LP3 G TEST
  540           S: $D(Y) CHRE FN=Y S ^DI SV(DUZ,"RE FNO")=Y
  541           I  '$D(^CHMXC LE("PDI",C HREFN)) D  MSG1 Q
  542           S  CHPCN=""
  543           S  CHPCN=$O(^ CHMXCLE("P DI",CHREFN ,CHPCN)) I  CHPCN=""  D MSG2 Q ; VALID PDI, NO DATA
  544           S  CHMXCLI=0
  545           S  CHMXCLI=$O (^CHMXCLE( "PDI",CHRE FN,CHPCN,C HMXCLI)) I  'CHMXCLI  D MSG2 Q ; VALID PDI,  NO DATA
  546           S  CHMXID=""
  547           S  CHMXID=$O( ^CHMXCLE(" PDI",CHREF N,CHPCN,CH MXCLI,CHMX ID)) I CHM XID="" D M SG2 Q 
  548           S  CHAI=$P(CH MXID,"*",1 ) W !!,"A( I)= ",CHAI
  549           S  CHBTCH=$P( ^CHMXCLA(C HAI,0),"^" ,1) 
  550           S  CHBI=$P(CH MXID,"*",2 ) W !,"B(I )= ",CHBI
  551           S  CHCI=$P(CH MXID,"*",3 ) W !,"C(I )= ",CHCI
  552           S  CHEI=$P(CH MXID,"*",4 ) W !,"E(I )= ",CHEI
  553           S  CHFI=0,CHF I=$O(^CHMX CLF("B",CH EI,CHFI))  W !,"F(I)=  ",CHFI,!! !
  554           W  !,"PDI: ", CHREFN," W AS PROCESS ED FROM BA TCH FILE:  ^CHMXCL(", CHBTCH,!!
  555           W  !,"NOTE:   THE FOLLOW ING DATA I S EXTRACTE D FROM THE  CLAIM BUF FERS"
  556           W  !,"        FILEMAN DO ES NOT OUT PUT EMPTY  FIELDS, SO  THE INFOR MATION"
  557           W  !,"        YOU SEE RE PRESENTS A LL THE NOD ES/FIELDS  THAT ARE P OPULATED." ,!!
  558           D  BTCHDUMP(C HBTCH)
  559           Q: $D(DUOUT)
  560           D  ABDUMP(CHA I)
  561           Q: $D(DUOUT)
  562           D  BBDUMP(CHB I)
  563           Q: $D(DUOUT)
  564           D  CBDUMP(CHC I)
  565           Q: $D(DUOUT)
  566           D  EBDUMP(CHE I)
  567           Q: $D(DUOUT)
  568           D  FBDUMP(CHF I)
  569           Q
  570           
  571   BTCHDUMP(I VAL)
  572           W  !,?10,"837  CLAIM BAT CH FILE ^C HMXCL(",IV AL,",0)",! !
  573           S  DA=IVAL
  574           S  DIC="^CHMX CL"_"(" 
  575           D  EN^DIQ
  576           Q 
  577           
  578   ABDUMP(IVA L)
  579           W  !,?10,"837  TRANSACTI ON BUFFER  ^CHMXCLA(" ,IVAL,",0) ",!!
  580           S  DA=IVAL
  581           S  DIC="^CHMX CLA"_"(" 
  582           D  EN^DIQ
  583           Q 
  584           
  585   BBDUMP(IVA L)
  586           N  NODE  S NO DE=1
  587           W  !?10,"PROV IDER BUFFE R  ^CHMXCL B(",IVAL," ,0)",!!
  588           S  DA=IVAL
  589           S  DIC="^CHMX CLB"_"(" 
  590           D  EN^DIQ
  591           Q 
  592           
  593   CBDUMP(IVA L)
  594           W  !,?10,"PAT IENT BUFFE R ^CHMXCLC (",IVAL,", 0)",!!
  595           S  DA=IVAL
  596           S  DIC="^CHMX CLC"_"(" 
  597           D  EN^DIQ
  598           Q 
  599           
  600   EBDUMP(IVA L)
  601           W  !,?10,"CLA IM BUFFER  ^CHMXCLE(" ,IVAL,",0) ",!!
  602           S  DA=IVAL
  603           S  DIC="^CHMX CLE"_"(" 
  604           D  EN^DIQ
  605           Q
  606           
  607   FBDUMP(IVA L)
  608           N  CLMID,TSTV AL,EXIT
  609           S  CLMID=$P(^ CHMXCLF(IV AL,0),"^", 1),EXIT=0
  610           F   S TSTVAL= $P($G(^CHM XCLF(IVAL, 0)),"^",1)  Q:EXIT  D
  611           .I  TSTVAL'=C LMID S EXI T=1 Q
  612           .W  !,"LINE I TEM BUFFER  ^CHMXCLF( ",IVAL,",0 )  CLM #:" ,CLMID,"       LINE N UMBER: ",$ P(^CHMXCLF (IVAL,0)," ^",2),!!
  613           .S  DA=IVAL
  614           .S  DIC="^CHM XCLF"_"(" 
  615           .D  EN^DIQ
  616           .S  IVAL=IVAL +1
  617           Q   
  618           
  619           
  620   HLP1    W  !!,"Enter  either 'R'  to look u p an HAC R eference N umber or ' C' to look  up a",!," provider s upplied Cl aim/Patien t Control  Number"
  621           Q
  622           ; 
  623   HLP2    W  !!,"Enter  the HAC Re ference Nu mber to lo ok up."
  624           Q
  625           ; 
  626   HLP3    W  !!,"The HA C Referenc e Number M UST be 15  characters  in length , eg: 2000 1580000015 4"
  627           W  !!,"Press  <RETURN> t o Continue  . . . ."  R X:999
  628           Q
  629           
  630   MSG1    W  !!,"That H AC Referen ce Number  could NOT  be found i n the EDI  Buffer Fil es."
  631           W  !,"Please  contact OC IO HELP DE SK if you  believe th is to be a n error."
  632           Q
  633           ; 
  634   MSG2    W  !!,"While  that HAC R eference N umber does  exist, no  data in t he EDI Buf fer Files" ,!,"could  be found.   Please co ntact OCIO  HELP DESK ."
  635           Q
  636           ; 
  637   SBRS    R  Y:$S($D(DT IME):DTIME ,1:999)
  638           I  '$T W *7 R  Y:999 G S BRS:Y="."  S:'$T Y=IO ZFO
  639   SBRS1   K  DFOUT,DUOU T,DQOUT 
  640           S: '$D(IOZFO)  IOZFO="^^
  641           S: '$D(IOZBK)  IOZBK="^"
  642           I  IOZFO=Y W: $D(IOZF) @ IOZF S (DF OUT,Y)=""  Q
  643           S: Y=IOZBK (D UOUT,Y)=""  
  644           S: Y?1"?".E!( Y["^") (DQ OUT,Y)=""
  645           Q
  646           ;
  647           
  648           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  649           ;  MORE_SCROL L_EXIT FUN CTION PROV IDED FOR Q A IN RESPO NSE TO THE  STATISTIC S REPORT
  650           ;  DATA DISPL AY.  JEFF  N. REQUIRE D THIS CAP ABILITY FO R VIEWING  THE STATIS TICS
  651           ;  DETAIL REP ORT WHEN I T HAS BEEN  SET TO "V IEW" MODE.
  652           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  653           
  654   MOSCREX(PA GE)            ; "MOR E","SCROLL ","EXIT" R OUTINE
  655   GET     W  !!,"ENTER  ""M"" -OR-  ""<CR>""  FOR MORE,  ""S"" FOR  SCROLL, "" ^^"" TO EX IT:  "
  656           S  Y="" D SBR S  
  657           S  PAGE=$S("M m"[Y:($Y+2 0),"Ss"[Y: 0,1:($Y+20 ))
  658           Q  PAGE
  659           
  660           
  661           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  662           ;  OUTPUT DEB UG STATEME NTS TO A L OGFILE.TXT  IN THE TA RGET DIREC TORY FOR T HE 
  663           ;  PRIMARY ST ATUS. THIS  FUNCTION  USES A PRE VIOUSLY CR EATED IO ( "LOGFILE") , OR
  664           ;  IF "LOGFIL E" IS NOT  DEFINED, O PENS A FIL E AN USES  THAT IO FO R DEBUG LO GGING.
  665           ;  NOTE: THE  SXC (PHARM ACY) CLAIM S ALL USE  THE SAME O UTPUT DIRE CTORY
  666           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  667           ;  EXAMPLE US AGE: D DEB UG^CHMXMDR V("DEBUG O UTPUT= ",V ARIABLE)
  668           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  669           
  670           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  671           ;  DEBUG LOGG ING ROUTIN E USED TO  LOG THE FR ONT END ED IT PROCESS , INCLUDIN G THE 
  672           ;  RECORDS RE AD FROM TH E CLAIM FI LE, THE FU NCTIONS CA LLED TO PE RFORM THE  EDITS,
  673           ;  AND THE LO GGING OF T HE ERRORS  ENCOUNTERE D FROM THE  EDIT PROC ESS.
  674           ;  THE INTEND ED USE FOR  THIS FUNC TION IS IN   THE DEVE LOPMENT OR  TEST ENVI RONMENTS
  675           ;  AND TO ENS URE THAT I T IS NOT E XECUTED IN  THE "PROD UCTION" EN VIRONMENT
  676           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;
  677             
  678   DEBUG(STR, VALUE)
  679           ;        STR               A USER P ROVIDED ST RING DESCR IBING THE  VALUE (I.E . "RECORD  INFORMATIO N=",
  680           ;    VALUE        THE VA LUE TO BE  DISPLAYED  IN THE LOG  FOR THE L OGGING ENT RY.
  681           N  ENV,TMPIO
  682                    S EN V=$$ENVIR^ CHTFLIB() 
  683           Q: ENV["LIVE"                                        ; CH ECK THE CU RRENT WORK ING ENVIRO NMENT
  684           S  TMPIO=$IO                                                                            ;  SAVE THE C URRENT IO  VARIABLE
  685           I  '$D(LOGFIL E) D                                                              ; IF NO LO GFILE CREA TED, CREAT E ONE
  686           .S  LOGFILE=" CHAMPVA_US ER:[ DNS     BUNTAD]ACC LOGFILE.TX T"  ; TRAG ET OUTPUT  DIR/FILENA ME
  687                    .;O  LOGFILE:"N WS":5 ; DE BUG OUTPUT  FILE                            ; OPEN THE  LOGFILE
  688                    .I ' $$OPENFIWR ^CHTFLIB9( .LOGFILE," LOGFILE")  Q       ;  DEF016554  02/04/2014
  689                    U LO GFILE W !, STR,VALUE                                                               ; OU TPUT LOGGI NG STATEME NT
  690                    U TM PIO                                                                                                  ; RESTOR E TO THE O RIGINAL IO
  691                    Q
  692           
  693           
  694                    ;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;
  695                    ; A  NUMBER OF  ROUTINES,  IN PARTICU LAR THE ED I BUFFER D ISPLAY ROU TINE CHMXI N01.INT
  696                    ; SE T UP SCREE N PARAMETE RS FOR DIS PLAYING DA TA FROM TH E CACHE GL OBAL FILES .  THE
  697                    ; PU RPOSE OF T HIS ROUTIN E IS TO "R ESET" THE  SCREEN TO  ALLOW SCRO LLING OF D ATA IN
  698                    ; A  NORMAL PRO CESS.  THI S HAS BEEN  ADDED TO  THIS UTILI TY ROUTINE  TO TO ALL OW A MORE
  699                    ; GE NERIC LOCA TION FOR T HE FUNCTIO N.
  700                    ;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;;
  701                    
  702   RESETSCR
  703           S  (IOF,IOZF) ="#,*27,*9 1,*50,*74, *27,*91,*7 2"
  704           S  CHALLOFF=" *27,*91,*4 8,*109"     ;SKD
  705           S  (CHMARESE, CHMARESET) ="*27,*91, *114"
  706           S  CHRESET="W  @CHMARESE ,@CHALLOFF ,#,@IOZF"    ;SKD
  707           XE CUTE CHRES ET
  708           Q
  709           
  710           
  711           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;
  712           ;  R2D2 (READ  2, DISPLA Y 2) WILL  OUTPUT THE  FIRST 2 L INES OF TH E FILES SP ECIFIED.         
  713           ;  THIS ROUTI NE WAS PLA GIERIZED F ROM THE IN TERSYSTEMS  FUNCTION  RFIRST(),  WHICH
  714           ;  DISPLAYS T HE FIRST L INE ONLY O F THE SPEC IFIED ROUT INES.  MOD IFICATIONS  WERE 
  715           ;  MADE TO DI SPLAY THE  SECOND LIN E IN ORDER  TO CHECK  THE VISTA  "KIDS" REQ UIREMENT
  716           ;  FOR THE FI LEMAN BUIL D HEADER. 
  717           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;  
  718           
  719   R2D2    ;P rint first  2 lines o f routines  ;LFT1320  11/02/04
  720           ;i n order of  directory , routine  name, exte nsion, ver sion.
  721           ;% sySystem.i nc ; HYY13 47 09/20/0 7
  722           ;% sySt.inc   ;HYY1347 0 9/20/07
  723           ;  %system.in c: compile d for USED YNPIDTAB
  724           ;  %system.in c: compile d for USED YNTTYHASH
  725           ;  %system.in c: compile d for USET TYHASH
  726           /*
  727           +- ---------- ---------- ---------- ---------- ---------- -----+
  728           |  Copyright  1986-2008  by InterSy stems Corp oration,        |
  729           |  Cambridge,  Massachus etts, U.S. A.                         |
  730           |  All rights  reserved.                                       |
  731           |                                                              |
  732           |  Confidenti al, unpubl ished prop erty of In terSystems .    |
  733           |                                                              |
  734           |  This media  contains  an authori zed copy o r copies        |
  735           |  of materia l copyrigh ted by Int erSystems  and is the      |
  736           |  confidenti al, unpubl ished prop erty of In terSystems .    |
  737           |  This copyr ight notic e and any  other copy right noti ces  |
  738           |  included i n machine  readable c opies must  be reprod uced |
  739           |  on all aut horized co pies.                                 |
  740           +- ---------- ---------- ---------- ---------- ---------- -----+
  741           */
  742   NMAX    I  '$G(NMAX)  N NMAX S N MAX=2 ;BB0 07
  743           ;E P with 'NM AX' = # of  top lines  to print
  744           I  '$D(NMAX)  N NMAX S N MAX=1
  745           N  POP,%msub, SELF,CRT,P AGE,NEWPAG E,DEFDIR
  746           N  DIRNAM,FRO MDN,THRUDN ,NOW,DATES ,%TIM
  747           N  %A,%E,%X,% ANS,IO,IOF ,IOM,IOST, IOT,IOBS,I OPAR,IOSL, RMSDF
  748           ;
  749           D  INT^%T S N OW=$ZDATE( +$H,2,,4)_ "  "_%TIM
  750           W  !,"Print f irst "_$S( NMAX=1:"li ne",1:NMAX _" comment  lines")
  751           W  " of selec ted routin es or incl ude files. ",!
  752           ;
  753           Ne w %NOWILDE XT Set %NO WILDEXT=1
  754           D  ^%RSETN("R outine(s):  ","SD","M AC,INT,INC ,BAS,MVB,M VI","DNEV" ) G KILL:P OP               ; DA S462,DAS47 2
  755           I  $O(^mtemp( %msub,"")) ="" G KILL
  756           ;
  757           D  DATES ;get  FROMDN, T HRUDN
  758           ;
  759           N  IOMS s IOM S=$System. Device.Get RightMargi n()
  760           W  !!,"Output  on" D OUT ^%IS G KIL L:POP
  761           S  SELF=($I=I O),CRT=($E (IOST)="C" ) S:'SELF  CRT=0
  762           S  NEWPAGE=1, PAGE="",DE FDIR=$$DEF DIR()
  763           ;
  764           U  IO D DOIT  I 'SELF U  IO W @IOF  C IO
  765           U: SELF IO:IO MS 
  766   KILL    I  $D(%msub)  K ^mtemp(% msub)
  767           U  0 Q
  768   DEFDIR()         N %A ,%ST,DEND, DIRNAM,GD, RD,NUMMAP  D DEFAULT^ %SYS.FILE  C 63 Q DIR NAM
  769   DOIT    ;g o through  the select ed routine s and prin t out the  first line s
  770           N  SD,SYS,DIR ,EXT,VER,R OU,BRACKET ,DATE,X,I, N,T,COUNT
  771           S  SD=""
  772   SD      S  SD=$O(^mte mp(%msub,S D)) I SD=" " Q
  773           S  SYS=$P(SD, "@"),DIR=$ P(SD,"@",2 ),ROU="",N EWPAGE=1,C OUNT=0
  774   ROU     S  ROU=$O(^mt emp(%msub, SD,ROU)) I  ROU="" G  SD
  775           S  EXT="" F   S EXT=$O(^ mtemp(%msu b,SD,ROU,E XT)) Q:EXT =""  D
  776           .  S VER="" F   S VER=$O (^mtemp(%m sub,SD,ROU ,EXT,VER))  Q:VER=""   D EXT
  777           Q: POP  G ROU
  778   EXT     ;f or each ex tension, g o through  the versio ns
  779           S  BRACKET=""
  780           S: DIR]"" BRA CKET=$S(SY S="":"|""" _DIR_"""|" ,1:"|""^"_ SYS_"^"_DI R_"""|")
  781           D  ONEROU
  782           Q
  783   VER     S  VER=$O(^mt emp(%msub, SD,ROU,EXT ,VER)) I V ER="" Q
  784           D  ONEROU G V ER
  785   ONEROU  ;f or one rou tine, figu re it all  out
  786           I  EXT="INT"  N VER S VE R=0
  787           ;D AS351+         
  788           I  EXT="BAS"! (EXT="MVI" ) N VER S  VER=0                     ; DAS4 62,DAS472
  789           ;D AS351-
  790           S  DATE=$$DAT E() I FROM DN]"",DATE <FROMDN Q   ;too earl y
  791           I  THRUDN]"", DATE>THRUD N Q  ;too  late
  792           ;
  793           N  NAME S NAM E=ROU_"."_ EXT_$S(VER >1:"."_VER ,1:"")
  794           D  CHKDY(NMAX +4) Q:POP
  795           S  COUNT=COUN T+1 ;numbe r of routi nes printe d
  796           I  'SELF U 0  W:COUNT-1# 5=0 ! W ?( COUNT-1#5* 15),NAME_"  " U IO
  797           ;
  798           W  !,NAME_" "  ;start wi th the rou tine name
  799           N  NL,NSP S N SP=$P(BRAC KET,"|",2) ,NL=$$LENG TH^%R(ROU_ "."_EXT_". "_VER,NSP)
  800           S  N=0 F I=1: 1:NL S T=$ $LINE^%R(R OU_"."_EXT _"."_VER,I ,NSP) I T] "" S N=N+1  D ONET Q: 'N
  801           I  NMAX>1,$X  W ! ;end w ith a blan k line
  802           Q
  803   ONET    I  N>NMAX S N =0 Q  ;too  many line s already
  804           I  N=1 G OUT  ;force pri nting it
  805           I  $P(T," ",2 ,999)?." " 1";".E G O UT ;it is  a comment
  806           I  T?." "1"#" 1A.E G OUT  ;it's a c ompiler di rective
  807           S  N=0 Q  ;ot herwise, s kip it
  808   OUT     ;p rint out T  on one or  more line s, given I OM
  809           S  X=$P(T," " ),X=$E(X_$ J("",7),1, 7)_$E(X,8, 99)_" "_$P (T," ",2,9 99)
  810           S  TB=$S($X>1 5:$X,1:15)
  811   LOOP    W  ?TB,$E(X,1 ,IOM-TB-1) ,! S X=$E( X,IOM-TB,* ),TB=15 I  X]"" G LOO P
  812           Q
  813   CHKDY(Y)         I 'N EWPAGE,$Y+ Y'>IOSL Q   ;no need  for new pa ge
  814           I  CRT,PAGE]" " N C W !  D MORE Q:P OP  ;BB008
  815           S  NEWPAGE=0, COUNT=0,PA GE=0 W @IO F ;skip to  new page
  816           D  CC("First  Line"_$S(N MAX=1:"",1 :"s")_" of  Selected  Routines F iles")
  817           I  DATES]"" D  CC(DATES)
  818           S  X=$S(DIR=" ":DEFDIR,1 :DIR)_$S(S YS]"":"  -   Director y Set: "_S YS,1:"")
  819           D  CC("Direct ory: "_X)  I 'CRT D C C(NOW)
  820           W  ! Q
  821   CC(X)   W  !?IOM-$L(X )\2,X Q
  822   MORE    R  !,"--more- -",*C I C' =10,C'=13, C'=27,C'=3 2,C'=53 S  POP=1 Q  ; BB008 ;BB1 51
  823           Q: C'=63  W "    Return  to continu e ^ to sto p" G MORE  ;BB008
  824   DATES   ;a sk a from- date -> up to-date pa ir
  825           N  %DS,%DN,FR OMDS,THRUD S,ERR
  826   FROM    R  !,"Find ro utines las t modified  since dat e: ",%DS S :%DS="" FR OMDN=""
  827           I  %DS="?" W  !!?4,"To i nclude rou tines/incl ude files  last modif ied"
  828           I   W !?4,"be tween sele cted dates , enter FR OM DATE he re.  To"
  829           I   W !?4,"in clude all  routines r egardless  of date, l eave blank .",!
  830           I   G FROM
  831           I  %DS]"" S % DS=$$UP(%D S) D Y2D^% DATE S FRO MDN=%DN I  %DN<1 W "   [???]" G  FROM ;BB17 4
  832           I  %DS]"" S % DS=$ZDATE( FROMDN,2,, 4) W "  (" _%DS_")"
  833   THRU    R  !,"                   and on or  before dat e: ",%DS S :%DS="" TH RUDN=""
  834           I  %DS="?" W  !!?4,"To i nclude rou tines/incl ude files  last modif ied"
  835           I   W !?4,"be tween sele cted dates , enter TH ROUGH DATE  here.  To "
  836           I   W !?4,"in clude all  routines r egardless  of date, "
  837           I   W:FROMDN> 0 "or sinc e "_$ZDATE (FROMDN,2, ,4)_", " W  ?4,"leave  blank.",!
  838           I   G THRU
  839           I  %DS]"" S % DS=$$UP(%D S) D Y2D^% DATE S THR UDN=%DN I  1 ;BB174
  840           I   S ERR=$S( THRUDN<1:"   [???]",T HRUDN<FROM DN:"  [?ba ckwards]", 1:"")
  841           I   I ERR]""  W ERR G TH RU
  842           I  %DS]"" S % DS=$ZDATE( THRUDN,2,, 4) W "  (" _%DS_")"
  843           I  FROMDN_THR UDN="" S D ATES="" Q
  844           I  FROMDN=""  S DATES="M odified on  or Before  "_$ZDATE( THRUDN,2,, 4) Q
  845           I  THRUDN=""  S DATES="M odified on  or After  "_$ZDATE(F ROMDN,2,,4 ) Q
  846           S  DATES="Mod ified betw een "_$ZDA TE(FROMDN, 2,,4)_" an d "_$ZDATE (THRUDN,2, ,4) Q
  847   DATE()  ;g iven DIR,S YS,VER; lo ok for the  date of R OU/EXT
  848           n  ENV 
  849           i  SYS="" s E NV=DIR
  850           e   s ENV="^" _SYS_"^"_D IR
  851           Q  $$DATE^%R( ROU_"."_EX T_"."_VER, ,ENV)
  852           Q  ""
  853   UP(x)   Q  $zcvt(x,"u ")
  854