202. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 11/9/2018 12:34:06 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.

202.1 Files compared

# Location File Last Modified
1 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHMMBM1P.m Mon Nov 5 16:45:27 2018 UTC
2 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHMMBM1P.m Mon Nov 5 17:50:52 2018 UTC

202.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 3 538
Changed 2 4
Inserted 0 0
Removed 0 0

202.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

202.4 Active regular expressions

No regular expressions were active.

202.5 Comparison detail

  1   CHMMBM1P ; HAC/JSG;NO  ALLERGY A SSESSMENT  / KNOWN AL LERGY REPO RT / EXPOR T (QUEUED) ;01/16/09; 10:10 AM
  2            ; Requiremen ts defined  by: DEV00 4771-02 &  BAT004771- 01                                       
  3            ; Keys: ALLE RGY ASSESS MENT, ADVE RSE REACTI ON, MBM, M EDS BY MAI L, AAR, KN OWN ALLERG Y, NKA; 
  4            ; The routin e prints o r exports  a list of  CHAMPVA el igible pat ients that  are activ e MbM   
  5            ; beneficiar ies who ei ther (user  selected)  have:                                              
  6            ;         1)  not compl eted an al lergy asse ssment (NA A)                                       
  7            ;         2)  completed  allergy a ssessment  but have n o known al lergies on  file (NKA )       
  8            ; The report s select b eneficiari es that ha ve a presc ription ac tive or 1  filled in  the past
  9            ; year from  the date o f the repo rt run. Ex ported lis ts are sav ed in Fs3b ig folder:  MBMCMOP
  10            ;
  11            ; ;DEV012893 -08 YJK Ma r 2014
  12            ;
  13            N  POP
  14            S  POP=0
  15            N  TYPE,STYL E,DEL,EM,T AB,IOFILE, QED,ALL,ST ATE
  16            S  U="^",QED =0,XDUZ=DU Z Q:"^^@"[ $$CRITERIA                               ;R un time pa rameters
  17            I  $D(IO("Q" ))!(TYPE=" E") S QED= 1                                                  ;2  Q ! '2 Q
  18            S  TAB=$S(DE L'="":DEL, 1:U)
  19            I F 'QED { D  AAR W !!, "Report Co mplete,"                                             ; If 'Qing
  20                       R  " type <E nter> to c ontinue: " ,X:10 }
  21            E LSE  { S Z TRTN="AAR^ CHMMBM1P"  D VARSAVE, ^%ZTLOAD                                    ;If Qing
  22                     ;S  IOP="HOME"  D HOME^%Z IS                                                 ;'N ecessary
  23                     W:$ D(ZTSK) !, "Your Task  Number is : ",ZTSK R  X:3 }
  24            Q
  25            ;
  26   CRITERIA()  ;TYPE=P!E ;STYLE=A!K ;DEL=delim iter;
  27               S (TYPE,S TYLE,DEL,Q ED,TAB,IOF ILE,CHUCI, ALL,STATE) =""
  28               W !!,"MbM  Allergy A ssessment  Report:",!
  29               W !,"This  option wi ll produce  a list or  export fi le of acti ve, eligib le patient s"
  30               W !,"that  have eith er No Alle rgy Assess ment (NAA)  and/or No  Known All ergies (NK A)"
  31               W !,"from  all or se lected sta tes."
  32               W !!,"Con tinue?" Q: $$YN^ACKQU TL(1)<1 U  W !
  33               S ALL=$$A orS() Q:AL L=U U                     ;All p atients or  those of  a particul ar state
  34               IF ALL="S " { S STAT E=$$State( ) }                                               ;Get  a state
  35               ELSE        { S STAT E=ALL        }
  36               Q:STATE=U  U                                       
  37               S TYPE=$$ PorE() Q:T YPE=U U                                                 ;Print or  export?
  38               I TYPE="E " S DEL=$$ DChar() Q: DEL="@" U  S:DEL="<Ta b>" DEL=$C (9)     ;D elimiter c haracter
  39               D NOW^%DT C S TODAY= X
  40               I TYPE="P " W !!,"Re port requi res a ""WI DE"" print er.",!!
  41               I  S IOP= "Q" D ^%ZI S Q:POP U                                       ;If pr inting, ge t device
  42               X ^%ZOSF( "UCI") S C HUCI=$P(Y, ",")
  43               IF TYPE=" P" { W !," Printing M bM No "
  44                              W $S( STYLE="NAA ":"Allergy  Assessmen t",1:"Know n Allergy" )
  45                              W " R eport to:  ",IO,ION," .",! }
  46               ELSE { S  IOFILE="AA R_"_DUZ_"_ "_TODAY_"_ "_($P($H," ,",2)\60)
  47                   S:CHU CI'="HAC"  IOFILE=IOF ILE_"_TST"  S IOFILE= IOFILE_".T XT"
  48                      W  !!,"Export ing select ed AAR det ail to:"
  49                      W  !!,?22,"Da ta share:  Fs3big",!, ?26,"Folde r: MBMCMOP "
  50                      W  !,?28,"Fil e: ",IOFIL E,! }
  51               Q 1
  52               ;
  53   DFD(D) Q $ E(D,4,5)_" /"_$E(D,6, 7)_"/"_$E( D,2,3) ;Fo rmat date
  54          ;
  55   VARSAVE ;S ave variab les for qu eued job:
  56           S  CHFIO=$G(I ON),ZTIO=" " S PAR=$$ VPACK
  57           S  ZTDESC="Al lergy Asse ssment "_$ S(TYPE="P" :"Report", 1:"File Ex tract")
  58           S  (ZTSAVE("C HFIO"),ZTS AVE("U"),Z TSAVE("PAR "))=""
  59           Q
  60           ;
  61   VPACK() Q  $LB(TYPE,S TYLE,DEL,Q ED,TAB,TOD AY,IOFILE, CHUCI,XDUZ ,ALL,STATE )
  62           ;
  63   VSET(P) S  TYPE=$LI(P ,1),STYLE= $LI(P,2),D EL=$LI(P,3 ),QED=$LI( P,4),TAB=$ LI(P,5)
  64           S  TODAY=$LI( P,6),IOFIL E=$LI(P,7) ,CHUCI=$LI (P,8),XDUZ =$LI(P,9)
  65           S  ALL=$LI(P, 10),STATE= $LI(P,11)  Q
  66           ;
  67   AAR ;Scan  In-house Q ueue date  entry inde x beginnin g with Sta rt Date:
  68        K ^TM P($J,"AAR" ) D:'$D(QE D) VSET(PA R) S IEN=0                                              ;Unpack
  69        S YR= $E(TODAY,2 ,3)-$S(CHU CI="DEV":2 ,CHUCI="TS T":2,1:1)         ;Ma ke it 2 ye ars ago if  testing
  70        S YRA GO=TODAY,$ E(YRAGO,2, 3)=$E("00" ,1,2-$L(YR ))_YR
  71   P    ;Phar macy Patie nt File:
  72        S IEN =$O(^PS(55 ,IEN)) G A AREND:IEN' >0                                    ;Get  a pharmacy  patient
  73        K DFN ,BFN,BES
  74        G P:' $D(^PS(55, IEN,0),PP0 ) S PFN=$P (PP0,U)
  75        ;Pati ent file:
  76        I $D( ^DPT(PFN,. 35),DOD) G  P:$P(DOD, U)>0                                        ;Skip, if  deceased
  77        G P:' $$ACTIVE(I EN,YRAGO)                                     ;Skip, i f no activ e pharmacy  profile
  78        G P:' $D(^DPT(PF N,0),D0)                                                 ;Skip, i f no patie nt entry
  79        ;Adve rse Reacti on Assessm ent File ( Allergy As sessment):
  80        S (NA A,NKA)=""
  81        IF '$ D(^GMR(120 .86,"B",PF N)) { S NA A="___" }
  82        ELSE  { S RA=$P( ^GMR(120.8 6,PFN,0),U ,2)
  83                IF 'RA {  S NKA=" X  " }
  84                ELSE   {  S PP=0,NK A=" X "
  85                         ;Patient A llergies F ile:
  86                         WHILE $O(^ GMR(120.8, "B",PFN,PP ))>0,NKA'= "" { S PP= $O(^(PP))
  87                             S PAM= $P(^GMR(12 0.8,PP,0), U,14)
  88                             S NKA= $S(PAM="P" :" X ",1:" ") } } }
  89        G P:N AA'["_"&(N KA'["X")                                                        ; Neither NA A or NKA
  90        S PNA ME=$P(D0,U ),PSSN=$P( D0,U,9) K  DOD,BES                                ;Get  patient n ame, SSN
  91        ;CHAM PVA Benefi ciary File :
  92        IF PS SN'="" {
  93           I  $D(^AHCHVA ("G",PSSN) ) { S DFN= $O(^AHCHVA ("G",PSSN, 0))             ;Chec k DOD, eli gibility
  94               IF DFN>0  { S BFN=$O (^AHCHVA(" G",PSSN,DF N,0))
  95               IF BFN>0, $D(^AHCHVA (DFN,100,B FN,0),X) {  
  96                  S DOD= $P(X,U,6), BES=$P(X,U ,5) }                                    ;D OD, eligib ility
  97               ELSE { K  BFN,DOD }  }
  98           EL SE { K DFN ,DOD } }
  99        ELSE  { S PNAME= $E(PNAME,1 ,27)_$E("                              ",$L (PNAME)+1, 27)_" **"  } }
  100     G:$G(DOD )>0 P                                                                    ;Sk ip, if dec eased
  101   P1  I $G(B ES)'="EA", PNAME'["*"  G P                                                ;S kip, if 'e ligible
  102        IF '$ D(^DPT(PFN ,.11),D11)  { S (A1,A 2,A3,CTY,S T,ZIP)=""   }                          ;Get  address
  103        ELSE  { S A1=$P( D11,U),A2= $P(D11,U,2 ),A3=$P(D1 1,U,3)
  104                S CTY=$P (D11,U,4), ST=$P(D11, U,5),ZIP=$ P(D11,U,6)  }
  105        I ALL ="S",ST="" !(ST'=$P(S TATE,U,2))  G P              ;Pa tient in n ot correct  state for  listing
  106        S ST= $P(^DIC(5, ST,0),U,2)                                                  ;Get  state abbr eviation
  107        IF '$ D(^DPT(PFN ,.13),D13)  { S PH=""  }                                                ;Get  phone #
  108        ELSE  { S PH=$P( D13,U) S:P H'="" PH=$ $AT(PH," [ R]") }
  109        IF PH ="" {                                                        ;If  null,try o ther phone  numbers
  110        IF $P (D13,U,2)' ="" { S PH =$$AT($P(D 13,U,2),"  [W]") }
  111        ELSEI F $P(D13,U ,4)'="" {  S PH=$$AT( $P(D13,U,4 )," [C]")  } }
  112     IF PH="" ,$D(DFN),$ D(BFN) {                          ;If all n ull, try C HAMPVA dat abase for  phone
  113        IF DF N>0,BFN>0, $D(^AHCHVA (DFN,100,B FN,1),X),$ P(X,U,6)'= "" { S PH= $P(X,U,6)
  114           IF  $E(PH)?1N  { S:PH?.N  PH=$E(PH, 1,3)_"-"_$ E(PH,4,6)_ "-"_$E(PH, 7,10)
  115                            S PH=$$ AT(PH," [B ]") } } }
  116     S:PSSN'= "" PSSN=$E (PSSN,1,3) _"-"_$E(PS SN,4,5)_"- "_$E(PSSN, 6,9)
  117        S X=N AA_U_NKA_U _PNAME_U_P SSN_U_PH_U _A1_U_A2_U _A3_U_CTY_ U_ST_U_ZIP
  118        S ^TM P($J,"AAR" ,STATE,PNA ME,PFN)=X                                              ;Save for  printing
  119        G P
  120        ;
  121   AT(P,T) ;( Phone, Typ e);Add pho ne type to  phone # s tring:
  122           I  $E(P)="("  S P=$E(P,2 ,15),P=$TR (P,")","-" )
  123           I  P?.N1" ".N 1" ".N S P =$TR(P," " ,"-")
  124           Q  $S($E(P)'? 1N:P,1:P_T )
  125   ACTIVE(I,D ) ;(psIen, Date 1 yea r ago);Che ck that pr escription  dates are  within th e past yea r
  126                N XD,PIE N,PP0,PPST A
  127                S XD=999 9999
  128                I '$D(^P S(55,I,"P" ,0)) Q 0                                       ;No pre scription  profiles
  129   PS           S XD=$O( ^PS(55,I," P","A",XD) ,-1),PIEN= 0 I XD'>0! (XD<D) Q 0    ;No act ive profil es found
  130   PSRX         S PIEN=$ O(^PS(55,I ,"P","A",X D,PIEN)) G  PS:PIEN'> 0
  131                G PSRX:' $D(^PSRX(P IEN,2),PP0 )!'$D(^PSR X(PIEN,"ST A"),PPSTA)    ;No pha rma or sta tus node
  132                G PSRX:$ P(PP0,U)<D !PPSTA            ;Lo gin date o lder than  1 year ago  or status  'active
  133                Q 1                                                                           ;Profil e active
  134                ;
  135   AAREND ;Sp in off out put:
  136           I  'QED G AAR IO
  137           S  %ZIS="Q",I OP="Q;"_CH FIO D ^%ZI S K ZTIO
  138           S  ZTRTN="AAR IO^CHMMBM1 P",ZTDESC= "Allergy A ssessment" ,ZTDTH=$H
  139           S  PAR=$$VPAC K,(ZTSAVE( "G("),ZTSA VE("PAR"), ZTSAVE("CH FIO"),ZTSA VE("^TMP($ J,"))=""
  140           D  ^%ZTLOAD
  141           Q
  142           ;
  143   AARIO ;Put  accumulat ed data to  printer o r file:
  144         D:'$ D(QED) VSE T(PAR)
  145         IF T YPE="E" {
  146          ;DE V012893-08  YJK Mar 2 014
  147            ;S XFILE=" HACFS3"" DNS     decnet HAC dec741!"": :D:[Fs3big .MBMCMOP]"
  148          ;S  XFILE=XFIL E_IOFILE       
  149          ;O  XFILE:"NWS "
  150          ;D  INIT(1),HE ADER(1),DE TAIL C XFI LE   
  151              N FOLDER,C NTR
  152              S FILE=IOF ILE_".TXT" ,FOLDER=""
  153              S IOF="#,* 27,*91,*50 ,*74,*27,* 91,*72"
  154              X ^%ZOSF(" UCI") S UC I=$P(Y,"," ,1)
  155              I UCI="HAC " S FOLDER ="HAC_HFS$ :[SCR.TEMP _FILES]"
  156              I UCI'="HA C" S FOLDE R="HAC_HFS $:[DSMMANA G.CHAMPVA] "
  157              S FILE=FOL DER_FILE
  158              S POP=0,CN TR=0
  159              F  S CNTR= CNTR+1 Q:( CNTR>5)!PO P  D  
  160              .S POP=$$O PENFIWR^CH TFLIB9(.FI LE,"FILE")
  161              .Q
  162              Q:'POP
  163          D I NIT(1),HEA DER(1),DET AIL D CLOS EF^CHTFLIB 9(FILE,"FI LE")
  164            D FTPFILE^ CHTFLIB9(F ILE," DNS     fs3. DNS             ","/FS3BIG /MBMCMOP", "PUT") }
  165       ELSE{
  166              D INIT(0), HEADER(0,1 ),DETAIL
  167              W !!,"Tota l ",$J(TOT AL,5),?76, "End of Re port ;s&"  }
  168          K ^ TMP($J,"AA R")
  169          Q
  170         ;
  171   DETAIL ;Pr int or exp ort bene:
  172          S ( STATE,PNAM E)="",(PFN ,TOTAL)=0
  173   DS     S S TATE=$O(^T MP($J,"AAR ",STATE))  Q:STATE=""
  174   DN     S P NAME=$O(^T MP($J,"AAR ",STATE,PN AME)) G DS :PNAME=""
  175   DP     S P FN=$O(^TMP ($J,"AAR", STATE,PNAM E,PFN)) G  DN:PFN'>0
  176          S X =^TMP($J," AAR",STATE ,PNAME,PFN )
  177          D O UTPUT(X,TY PE)
  178          G D P
  179          ;
  180   HC(L) D:$Y +L>$S(CHUC I="HAC":59 ,1:58) HEA DER(0,1) Q  1 ;
  181   OUTPUT(X,T ) ;(Xrec,  Type);Put  a row out  to printer  or file:
  182                IF T="E"  { S X=$TR (X,U,TAB)
  183                            U XFILE  W X,! }
  184                ELSE {
  185                S PSSN=$ P(X,U,4)
  186                   S PAD =$E($P(X,U ,6)_", "_$ P(X,U,7)_" , "_$P(X,U ,8),1,56)
  187                   S CSZ =$P(X,U,9) _", "_$P(X ,U,10)_"    "_$P(X,U, 11)
  188                   W:$$H C(2) !,$P( X,U),?5,$P (X,U,2),?1 0,$P(X,U,3 ),?43,PSSN ,?57,$P(X, U,5),?76,P AD
  189                   W:$I( TOTAL) !,? 76,CSZ }
  190                Q
  191                ;
  192   HEADER(EF, CPF) ;Prin t or expor t header ( EF=Export  Flag, CPF= Column tit le Print F lag):
  193                   IF EF  { U XFILE  W TAB,TAB ,"ALLERGY  ASSESSMENT  REPORT",T AB,DATE,TA B,TIME,TAB
  194                            W "**:  NO CHAMPVA  MATCH",!, HDR,! }
  195                   ELSE  {
  196                   I PG> 1 W !,?10, "** denote s patients  with SSNs  not match ing a CHAM PVA benefi ciary."
  197                   W @IO F,DUZ,?TT, TITLE,?123 ,"Page: ", $J(PG,3),! ,DATE,?ST, SUB
  198                   W !,T IME,?PT,PA RAM,!
  199                      D: CPF COLUMN  S PG=PG+1  }
  200                   Q
  201                   ;
  202   INIT(EF) ; Set up pri nt or expo rt header  (EF=Export  Flag):
  203            S  DATE=$$FI X($$FMTE^D ILIBF(TODA Y,6)),TIME =$$HTIM^AC KQUTL($H,0 )
  204            I F EF {
  205              S HDR=""
  206                 F I=1:1 :11 S HDR= HDR_$P($P( $T(FHDR)," ;",2),U,I) _$S(I'=12: TAB,1:"")  }
  207            E LSE  {
  208              S TITLE="D EPARTMENT  OF VETERAN S AFFAIRS" ,TT=66-($L (TITLE)\2)
  209                 IF STYL E["K" { S  SUB="NO KN OWN ALLERG Y"      }
  210                 ELSE          { S  SUB="NO AL LERGY ASSE SSMENT" }
  211                 S PARAM ="(PHONE #  Type: [R] esidence,  [W]ork, [C ]ellular,  [B]enefici ary)"
  212                 S SUB=" MbM "_SUB_ " REPORT ( "
  213                 S SUB=S UB_$S(ALL= "A":"ALL S TATES",1:$ P(^DIC(5,$ P(STATE,U, 2),0),U))_ ")"
  214                 S ST=66 -($L(SUB)\ 2),PG=1,PT =66-($L(PA RAM)\2) }
  215            Q
  216   FHDR ;NAA^ NKA^PATIEN T NAME^SSN ^PHONE # [ Type]^ADDR ESS 1^ADDR  2^A 3^CIT Y^STATE^ZI P;
  217        ;
  218   FIX(D) Q $ E(D,1,2)_" /"_$E(D,4, 5)_"/"_$E( D,7,10) ;< Replace "- " with "/"  in (D)ate
  219          ;
  220   COLUMN ;Pr int column  titles
  221          W ! ,"NAA",?5, "NKA",?10, "PATIENT N AME",?43," SSN",?57
  222          W " PHONE # [T ype]",?76, "ADDRESSES  / CITY, S TATE, ZIP"
  223          W ! ,"---  --- ",?10,"--- ---------- ---------- -------",? 43,"------ -----"
  224          W ? 57,"------ ---------- "
  225          W ? 76,"------ ---------- ---------- ---------- ---------- ---------- "
  226          Q
  227          ;
  228          ;Ru n time par ameters (c riteria):
  229   AorS() ;So licit whet her to lis t All or p atients of  a particu lar state:
  230          K D IR S DIR(0 )="SAB^A:A ll states; S:Selected  state"
  231          S D IR("A")="               (A)ll or  a (S)elec ted state:  ",DIR("B" )="A"
  232          S D IR("PRE")= "I X=""""  S X=""A""  W X"
  233          S D IR("?")="" "A"" lists  patients  from all s tates, ""S """
  234          S D IR("?")=DI R("?")_" o nly lists  patients f rom a stat e to be en tered."
  235          D ^ DIR K DIR  Q:"^^@"[X  "^"
  236          Q Y
  237          ;
  238   State() ;S olicit whi ch state f rom which  to list pa tients:
  239           ;K  DIC S DIC =741002.83 ,DIC(0)="A EQMN"
  240           K  DIC S DIC= 5,DIC(0)=" AEQMN"
  241           S  DIC("A")=" Select sta te from wh ich to lis t patients : "
  242           S  DIC("S")=" I $D(^CHMD IC(741002. 83,""B"",Y ))"
  243           D  ^DIC K DIC
  244           Q: "^^@"[X "^ "
  245           Q  $P(^DIC(5, $P(Y,U),0) ,U,2)_U_$P (Y,U)
  246   PorE() ;So licit outp ut destina tion (prin t or expor t):
  247          K D IR S DIR(0 )="SAB^P:P rint to se lected dev ice;E:Expo rt to deli mited text  file"
  248          S D IR("A")="           ( P)rint or  (E)xport t he output:  ",DIR("B" )="E"
  249          S D IR("PRE")= "I X=""""  S X=""E""  W X"
  250          S D IR("?")="" "P"" uses  a WIDE pri nter, ""E" " creates  a .TXT fil e."
  251          D ^ DIR K DIR  Q:"^^@"[X  "^"
  252          Q Y
  253          ;
  254   NAAorNKA()  ;Solicit  hardcopy r eport styl e (No Asse ssment or  No Allergy ):
  255          K D IR S DIR(0 )="SAB^A:N AA - No Al lergy Asse ssment;"
  256          S D IR(0)=DIR( 0)_"K:NKA  - No Known  Allergy"
  257          S D IR("A")="    No (A)ss essment or  (K)nown A llergy Rep ort?: ",DI R("B")="A"
  258          S D IR("PRE")= "I X=""""  S X=""A""  W X"
  259          S D IR("?")="" "A"" print s benefici aries with out an ass essment"
  260          S D IR("?")=DI R("?")_" a nd ""K"" b eneficiari es with an  assessmen t but no k nown aller gies."
  261          D ^ DIR K DIR  Q:"^^@"[X  "^"
  262          Q Y
  263          ;
  264   DChar() ;S olicit fie ld delimit er:
  265           K  DIR S DIR( 0)="FAU^"
  266           S  DIR("A")="                  Fiel d delimite r for file : ",DIR("B ")="<Tab>"
  267           S  DIR("PRE") ="I X=""""  S X=""<Ta b>"" W X"
  268           S  DIR("?")=" Enter a ch aracter to  placed be tween fiel ds in the  output dat a file."
  269           D  ^DIR K DIR  Q:"@"[X " @"
  270           Q  Y
  271           ;