Released DG*5.3*876 SEQ #784 Extracted from mail message **KIDS**:DG*5.3*876^ **INSTALL NAME** DG*5.3*876 "BLD",3007,0) DG*5.3*876^REGISTRATION^0^3140818^y "BLD",3007,1,0) ^^3^3^3140812^ "BLD",3007,1,1,0) MASTER VETERAN INDEX VISTA ISSUES - ITERATION 12 "BLD",3007,1,2,0) Refer to patch DG*5.3*876 in the FORUM Patch Module for a complete "BLD",3007,1,3,0) description. "BLD",3007,4,0) ^9.64PA^2^1 "BLD",3007,4,2,0) 2 "BLD",3007,4,2,2,0) ^9.641^2^1 "BLD",3007,4,2,2,2,0) PATIENT (File-top level) "BLD",3007,4,2,2,2,1,0) ^9.6411^.024^1 "BLD",3007,4,2,2,2,1,.024,0) SELF IDENTIFIED GENDER "BLD",3007,4,2,222) y^y^p^^^^n^^n "BLD",3007,4,2,224) "BLD",3007,4,"APDD",2,2) "BLD",3007,4,"APDD",2,2,.024) "BLD",3007,4,"B",2,2) "BLD",3007,6.3) 6 "BLD",3007,"INID") ^n "BLD",3007,"INIT") DG876PST "BLD",3007,"KRN",0) ^9.67PA^779.2^20 "BLD",3007,"KRN",.4,0) .4 "BLD",3007,"KRN",.401,0) .401 "BLD",3007,"KRN",.402,0) .402 "BLD",3007,"KRN",.403,0) .403 "BLD",3007,"KRN",.5,0) .5 "BLD",3007,"KRN",.84,0) .84 "BLD",3007,"KRN",3.6,0) 3.6 "BLD",3007,"KRN",3.8,0) 3.8 "BLD",3007,"KRN",9.2,0) 9.2 "BLD",3007,"KRN",9.8,0) 9.8 "BLD",3007,"KRN",9.8,"NM",0) ^9.68A^8^8 "BLD",3007,"KRN",9.8,"NM",1,0) DG876PST^^0^B57829017 "BLD",3007,"KRN",9.8,"NM",2,0) VAFCPDAT^^0^B52025374 "BLD",3007,"KRN",9.8,"NM",3,0) VAFCPDT2^^0^B28085527 "BLD",3007,"KRN",9.8,"NM",4,0) DPTLK^^0^B116067548 "BLD",3007,"KRN",9.8,"NM",5,0) VAFCSB^^0^B15691481 "BLD",3007,"KRN",9.8,"NM",6,0) VAFCPTAD^^0^B69026178 "BLD",3007,"KRN",9.8,"NM",7,0) VAFCTR^^0^B3892761 "BLD",3007,"KRN",9.8,"NM",8,0) VAFCQRY2^^0^B18522846 "BLD",3007,"KRN",9.8,"NM","B","DG876PST",1) "BLD",3007,"KRN",9.8,"NM","B","DPTLK",4) "BLD",3007,"KRN",9.8,"NM","B","VAFCPDAT",2) "BLD",3007,"KRN",9.8,"NM","B","VAFCPDT2",3) "BLD",3007,"KRN",9.8,"NM","B","VAFCPTAD",6) "BLD",3007,"KRN",9.8,"NM","B","VAFCQRY2",8) "BLD",3007,"KRN",9.8,"NM","B","VAFCSB",5) "BLD",3007,"KRN",9.8,"NM","B","VAFCTR",7) "BLD",3007,"KRN",19,0) 19 "BLD",3007,"KRN",19.1,0) 19.1 "BLD",3007,"KRN",101,0) 101 "BLD",3007,"KRN",409.61,0) 409.61 "BLD",3007,"KRN",771,0) 771 "BLD",3007,"KRN",779.2,0) 779.2 "BLD",3007,"KRN",870,0) 870 "BLD",3007,"KRN",8989.51,0) 8989.51 "BLD",3007,"KRN",8989.52,0) 8989.52 "BLD",3007,"KRN",8994,0) 8994 "BLD",3007,"KRN",8994,"NM",0) ^9.68A^1^1 "BLD",3007,"KRN",8994,"NM",1,0) VAFC VOA ADD PATIENT^^0 "BLD",3007,"KRN",8994,"NM","B","VAFC VOA ADD PATIENT",1) "BLD",3007,"KRN","B",.4,.4) "BLD",3007,"KRN","B",.401,.401) "BLD",3007,"KRN","B",.402,.402) "BLD",3007,"KRN","B",.403,.403) "BLD",3007,"KRN","B",.5,.5) "BLD",3007,"KRN","B",.84,.84) "BLD",3007,"KRN","B",3.6,3.6) "BLD",3007,"KRN","B",3.8,3.8) "BLD",3007,"KRN","B",9.2,9.2) "BLD",3007,"KRN","B",9.8,9.8) "BLD",3007,"KRN","B",19,19) "BLD",3007,"KRN","B",19.1,19.1) "BLD",3007,"KRN","B",101,101) "BLD",3007,"KRN","B",409.61,409.61) "BLD",3007,"KRN","B",771,771) "BLD",3007,"KRN","B",779.2,779.2) "BLD",3007,"KRN","B",870,870) "BLD",3007,"KRN","B",8989.51,8989.51) "BLD",3007,"KRN","B",8989.52,8989.52) "BLD",3007,"KRN","B",8994,8994) "BLD",3007,"QDEF") ^^^^NO^^^^NO^^YES "BLD",3007,"QUES",0) ^9.62^^ "BLD",3007,"REQB",0) ^9.611^7^7 "BLD",3007,"REQB",1,0) DG*5.3*797^2 "BLD",3007,"REQB",2,0) DG*5.3*800^2 "BLD",3007,"REQB",3,0) DG*5.3*825^2 "BLD",3007,"REQB",4,0) DG*5.3*857^2 "BLD",3007,"REQB",5,0) DG*5.3*863^2 "BLD",3007,"REQB",6,0) DG*5.3*712^2 "BLD",3007,"REQB",7,0) DG*5.3*428^2 "BLD",3007,"REQB","B","DG*5.3*428",7) "BLD",3007,"REQB","B","DG*5.3*712",6) "BLD",3007,"REQB","B","DG*5.3*797",1) "BLD",3007,"REQB","B","DG*5.3*800",2) "BLD",3007,"REQB","B","DG*5.3*825",3) "BLD",3007,"REQB","B","DG*5.3*857",4) "BLD",3007,"REQB","B","DG*5.3*863",5) "FIA",2) PATIENT "FIA",2,0) ^DPT( "FIA",2,0,0) 2I "FIA",2,0,1) y^y^p^^^^n^^n "FIA",2,0,10) "FIA",2,0,11) "FIA",2,0,"RLRO") "FIA",2,0,"VR") 5.3^DG "FIA",2,2) 1 "FIA",2,2,.024) "INIT") DG876PST "IX",2,2,"AVAFC024",0) 2^AVAFC024^This x-ref calls the DG FIELD MONITOR event point.^MU^^F^I^I^2^^^^^A "IX",2,2,"AVAFC024",.1,0) ^^5^5^3140415 "IX",2,2,"AVAFC024",.1,1,0) This cross-reference activates the DG FIELD MONITOR event point. "IX",2,2,"AVAFC024",.1,2,0) Applications that wish to monitor edit activity related to this field may "IX",2,2,"AVAFC024",.1,3,0) subscribe to that event point and take action as indicated by the changes "IX",2,2,"AVAFC024",.1,4,0) that occur. Refer to the DG FIELD MONITOR protocol for a description of "IX",2,2,"AVAFC024",.1,5,0) the information available at the time of the event. "IX",2,2,"AVAFC024",1) D FC^DGFCPROT(.DA,2,.024,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC024",2) D FC^DGFCPROT(.DA,2,.024,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC024",11.1,0) ^.114IA^1^1 "IX",2,2,"AVAFC024",11.1,1,0) 1^F^2^.024^^^F "KRN",8994,272,-1) 0^1 "KRN",8994,272,0) VAFC VOA ADD PATIENT^ADD^VAFCPTAD^2^R^0^^1^1 "KRN",8994,272,1,0) ^^3^3^3140514^ "KRN",8994,272,1,1,0) This Remote Procedure Call allows the remote creation of a VistA "KRN",8994,272,1,2,0) PATIENT (#2) record at the Preferred Facility for the Veteran "KRN",8994,272,1,3,0) On-Line Application (VOA) project. "KRN",8994,272,2,0) ^8994.02A^2^1 "KRN",8994,272,2,2,0) PARAM^2^2000^1^1 "KRN",8994,272,2,2,1,0) ^^66^66^3140514^ "KRN",8994,272,2,2,1,1,0) PARAM may contain the following values: (R) Required (O) Optional "KRN",8994,272,2,2,1,2,0) The values are passed into this RPC from the Master Patient Index (MPI) "KRN",8994,272,2,2,1,3,0) via the MPI PSIM ADD PREF FACILITY Remote Procedure. If internal format "KRN",8994,272,2,2,1,4,0) values are sent, they are converted to the external value for the "KRN",8994,272,2,2,1,5,0) UPDATE^DIE call. "KRN",8994,272,2,2,1,6,0) "KRN",8994,272,2,2,1,7,0) (R) PARAM("PRFCLTY") = Preferred Facility Station Number. Must be "KRN",8994,272,2,2,1,8,0) the same as the receiving site. "KRN",8994,272,2,2,1,9,0) (R) PARAM("NAME") = Last Name^First Name^Middle Name^Suffix is "KRN",8994,272,2,2,1,10,0) converted to: Last NameFirst Name "KRN",8994,272,2,2,1,11,0) Middle NameSuffix "KRN",8994,272,2,2,1,12,0) NAME of the applicant to be added to the PATIENT "KRN",8994,272,2,2,1,13,0) (#2) file. "KRN",8994,272,2,2,1,14,0) (R) PARAM("GENDER") = External format - MALE or FEMALE "KRN",8994,272,2,2,1,15,0) SEX of the applicant to be added to the PATIENT "KRN",8994,272,2,2,1,16,0) (#2) file. "KRN",8994,272,2,2,1,17,0) (R) PARAM("DOB") = External date format; can be imprecise. Month "KRN",8994,272,2,2,1,18,0) and/or day alone, without year is not allowed. "KRN",8994,272,2,2,1,19,0) DATE OF BIRTH of the applicant to be added to the "KRN",8994,272,2,2,1,20,0) PATIENT (#2) file. "KRN",8994,272,2,2,1,21,0) (R) PARAM("SSN") = Format: nine numbers / no dashes, or a NULL value. "KRN",8994,272,2,2,1,22,0) If SSN is sent with a null value, then on the "KRN",8994,272,2,2,1,23,0) VistA side, the patient is given a PSEUDO SSN "KRN",8994,272,2,2,1,24,0) number and the PSEUDO SSN REASON field is also set "KRN",8994,272,2,2,1,25,0) to "SSN UNKNOWN/FOLLOW-UP REQUIRED". SOCIAL "KRN",8994,272,2,2,1,26,0) SECURITY NUMBER of the applicant to be added to "KRN",8994,272,2,2,1,27,0) the PATIENT (#2) file. "KRN",8994,272,2,2,1,28,0) (R) PARAM("SRVCNCTD") = YES or NO "KRN",8994,272,2,2,1,29,0) Is the applicant to be added to the PATIENT "KRN",8994,272,2,2,1,30,0) (#2) file SERVICE CONNECTED? "KRN",8994,272,2,2,1,31,0) (R) PARAM("TYPE") = Primary patient TYPE: "KRN",8994,272,2,2,1,32,0) ACTIVE DUTY, "KRN",8994,272,2,2,1,33,0) ALLIED VETERAN, "KRN",8994,272,2,2,1,34,0) COLLATERAL, "KRN",8994,272,2,2,1,35,0) EMPLOYEE, "KRN",8994,272,2,2,1,36,0) MILITARY RETIREE, "KRN",8994,272,2,2,1,37,0) NON-VETERAN (OTHER), "KRN",8994,272,2,2,1,38,0) NSC VETERAN, "KRN",8994,272,2,2,1,39,0) SC VETERAN, OR "KRN",8994,272,2,2,1,40,0) TRICARE "KRN",8994,272,2,2,1,41,0) Primary patient TYPE of the applicant to be added "KRN",8994,272,2,2,1,42,0) to the PATIENT (#2) file. "KRN",8994,272,2,2,1,43,0) (R) PARAM("VET") = YES or NO "KRN",8994,272,2,2,1,44,0) Is the applicant to be added to the PATIENT (#2) "KRN",8994,272,2,2,1,45,0) file a VETERAN? "KRN",8994,272,2,2,1,46,0) (R) PARAM("FULLICN ") = A 10 digit NUMBER, followed by V (delimiter), "KRN",8994,272,2,2,1,47,0) followed by a 6 digit CHECKSUM NUMBER. "KRN",8994,272,2,2,1,48,0) The full INTEGRATION CONTROL NUMBER (ICN) "KRN",8994,272,2,2,1,49,0) of the applicant to be added to the PATIENT "KRN",8994,272,2,2,1,50,0) (#2) file. "KRN",8994,272,2,2,1,51,0) "KRN",8994,272,2,2,1,52,0) (O) PARAM("POBCTY") = City name. PLACE OF BIRTH [CITY] of the "KRN",8994,272,2,2,1,53,0) applicant to be added to the PATIENT (#2) file. "KRN",8994,272,2,2,1,54,0) (O) PARAM("POBST") = The incoming 2 character STATE ABBREVIATION "KRN",8994,272,2,2,1,55,0) is converted to the STATE NAME. PLACE OF "KRN",8994,272,2,2,1,56,0) BIRTH [STATE] of the applicant to be added "KRN",8994,272,2,2,1,57,0) to the PATIENT (#2) file. "KRN",8994,272,2,2,1,58,0) (O) PARAM("MMN") = MOTHER'S MAIDEN NAME. Maiden name of the mother "KRN",8994,272,2,2,1,59,0) of the applicant to be added to the PATIENT (#2) "KRN",8994,272,2,2,1,60,0) file. "KRN",8994,272,2,2,1,61,0) (O) PARAM("MBI") = MULTIPLE BIRTH INDICATOR. Y or N "KRN",8994,272,2,2,1,62,0) (O) PARAM("ALIAS",#) = ALIAS NAME (Last Name^First Name^Middle "KRN",8994,272,2,2,1,63,0) Name^Suffix) is converted to: (Last Name "KRN",8994,272,2,2,1,64,0) First NameMiddle Name "KRN",8994,272,2,2,1,65,0) Suffix)^ALIAS SSN "KRN",8994,272,2,2,1,66,0) The # subscript is a sequential number. "KRN",8994,272,2,"B","PARAM",2) "KRN",8994,272,2,"PARAMSEQ",1,2) "KRN",8994,272,3,0) ^8994.03^7^7^3100201^^^^ "KRN",8994,272,3,1,0) This RPC will return a positive (1) or negative response (-1) in "KRN",8994,272,3,2,0) RETURN(1), in the following format: result^text result "KRN",8994,272,3,3,0) "KRN",8994,272,3,4,0) Example output: "KRN",8994,272,3,5,0) -1^error text "KRN",8994,272,3,6,0) OR "KRN",8994,272,3,7,0) 1^DFN of the PATIENT (#2) file entry created "MBREQ") 0 "ORD",16,8994) 8994;16;1;;;;;;;RPCDEL^XPDIA1 "ORD",16,8994,0) REMOTE PROCEDURE "PKG",5,-1) 1^1 "PKG",5,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",5,20,0) ^9.402P^^ "PKG",5,22,0) ^9.49I^1^1 "PKG",5,22,1,0) 5.3^2930813^2970721^12541 "PKG",5,22,1,"PAH",1,0) 876^3140818 "PKG",5,22,1,"PAH",1,1,0) ^^3^3^3140818 "PKG",5,22,1,"PAH",1,1,1,0) MASTER VETERAN INDEX VISTA ISSUES - ITERATION 12 "PKG",5,22,1,"PAH",1,1,2,0) Refer to patch DG*5.3*876 in the FORUM Patch Module for a complete "PKG",5,22,1,"PAH",1,1,3,0) description. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 8 "RTN","DG876PST") 0^1^B57829017^n/a "RTN","DG876PST",1,0) DG876PST ;BIR/JFW - PATCH DG*5.3*876 POST INSTALLATION ROUTINE ; 12/23/13 4:31pm "RTN","DG876PST",2,0) ;;5.3;Registration;**876**;Aug 13, 1993;Build 6 "RTN","DG876PST",3,0) ; "RTN","DG876PST",4,0) ; IA #4397 (Supported) for call to TURNON^DIAUTL "RTN","DG876PST",5,0) POST ;Post init "RTN","DG876PST",6,0) N DGI,DGFLDS "RTN","DG876PST",7,0) ; Modifying the following field(s) in the PATIENT File #2: "RTN","DG876PST",8,0) ; - .024 SELF IDENTIFIED GENDER "RTN","DG876PST",9,0) S DGFLDS=".024" "RTN","DG876PST",10,0) ;File cross references for the field(s) (TRIGGERS) "RTN","DG876PST",11,0) F DGI=1:1:$L(DGFLDS,",") D XR(2,$P(DGFLDS,",",DGI)) "RTN","DG876PST",12,0) ;Re-Compile Templates for field(s) (if applicable) "RTN","DG876PST",13,0) D TEMPL(2,DGFLDS,"PATIENT") "RTN","DG876PST",14,0) ;Turning on AUDITING for field(s) "RTN","DG876PST",15,0) F DGI=1:1:$L(DGFLDS,",") D AUDIT(2,$P(DGFLDS,",",DGI),"Patient") "RTN","DG876PST",16,0) ; "RTN","DG876PST",17,0) D EMPA31 "RTN","DG876PST",18,0) ; "RTN","DG876PST",19,0) Q "RTN","DG876PST",20,0) ; "RTN","DG876PST",21,0) XR(DGFILE,DGFLD) ;File index type cross references "RTN","DG876PST",22,0) ; "RTN","DG876PST",23,0) N DGFDA,DGIEN,DGWP,DGERR,DGXR,DGVAL,DGOUT,DIERR "RTN","DG876PST",24,0) ;Set up the cross-reference "RTN","DG876PST",25,0) I '$D(DGXR) S DGXR=$S(DGFLD[".":"AVAFC"_$P(DGFLD,".",2),1:"AVAFC"_DGFLD) "RTN","DG876PST",26,0) ;Check for existing cross-reference "RTN","DG876PST",27,0) S DGVAL(1)=DGFILE,DGVAL(2)=DGXR "RTN","DG876PST",28,0) D FIND^DIC(.11,"","@;IXIE","KP",.DGVAL,"","","","","DGOUT") "RTN","DG876PST",29,0) I $D(DGOUT("DILIST",1)) D Q "RTN","DG876PST",30,0) .D MES^XPDUTL(" >> Cross reference "_DGXR_" already exists, nothing filed.") "RTN","DG876PST",31,0) .Q "RTN","DG876PST",32,0) ;Create filer array "RTN","DG876PST",33,0) S DGFDA(.11,"+1,",.01)=DGFILE ;FILE "RTN","DG876PST",34,0) S DGFDA(.11,"+1,",.02)=DGXR ;NAME "RTN","DG876PST",35,0) S DGFDA(.11,"+1,",.11)="This x-ref calls the DG FIELD MONITOR event point." ;SHORT DESCRIPTION "RTN","DG876PST",36,0) S DGFDA(.11,"+1,",.2)="MU" ;TYPE "RTN","DG876PST",37,0) S DGFDA(.11,"+1,",.4)="F" ;EXECUTION "RTN","DG876PST",38,0) S DGFDA(.11,"+1,",.41)="I" ;ACTIVITY "RTN","DG876PST",39,0) S DGFDA(.11,"+1,",.5)="I" ;ROOT TYPE "RTN","DG876PST",40,0) S DGFDA(.11,"+1,",.51)=DGFILE ;ROOT FILE "RTN","DG876PST",41,0) S DGFDA(.11,"+1,",.42)="A" ;USE "RTN","DG876PST",42,0) S DGFDA(.11,"+1,",1.1)="D FC^DGFCPROT(.DA,"_DGFILE_","_DGFLD_",""SET"",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q" ;SET LOGIC "RTN","DG876PST",43,0) S DGFDA(.11,"+1,",2.1)="D FC^DGFCPROT(.DA,"_DGFILE_","_DGFLD_",""KILL"",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q" ;KILL LOGIC "RTN","DG876PST",44,0) ;CROSS REFERENCE VALUES "RTN","DG876PST",45,0) S DGFDA(.114,"+2,+1,",.01)=1 ;ORDER NUMBER "RTN","DG876PST",46,0) S DGFDA(.114,"+2,+1,",1)="F" ;TYPE OF VALUE "RTN","DG876PST",47,0) S DGFDA(.114,"+2,+1,",2)=DGFILE ;FILE NUMBER "RTN","DG876PST",48,0) S DGFDA(.114,"+2,+1,",3)=DGFLD ;FIELD NUMBER "RTN","DG876PST",49,0) S DGFDA(.114,"+2,+1,",7)="F" ;COLLATION "RTN","DG876PST",50,0) ;DESCRIPTION "RTN","DG876PST",51,0) S DGWP(1)="This cross-reference activates the DG FIELD MONITOR event point." "RTN","DG876PST",52,0) S DGWP(2)="Applications that wish to monitor edit activity related to this field may" "RTN","DG876PST",53,0) S DGWP(3)="subscribe to that event point and take action as indicated by the changes" "RTN","DG876PST",54,0) S DGWP(4)="that occur. Refer to the DG FIELD MONITOR protocol for a description of" "RTN","DG876PST",55,0) S DGWP(5)="the information available at the time of the event." "RTN","DG876PST",56,0) ;File INDEX record "RTN","DG876PST",57,0) D UPDATE^DIE("","DGFDA","DGIEN","DGERR") "RTN","DG876PST",58,0) I $D(DIERR) D Q "RTN","DG876PST",59,0) .N DGI S DGI="" "RTN","DG876PST",60,0) .D BMES^XPDUTL(" >> A problem has occurred during the filing of x-ref "_DGXR_"!") "RTN","DG876PST",61,0) .D MES^XPDUTL(" Please contact Customer Support.") "RTN","DG876PST",62,0) .F S DGI=$O(DGERR("DIERR",1,"TEXT",DGI)) Q:DGI="" D "RTN","DG876PST",63,0) ..D MES^XPDUTL(DGERR("DIERR",1,"TEXT",DGI)) "RTN","DG876PST",64,0) ..Q "RTN","DG876PST",65,0) .Q "RTN","DG876PST",66,0) D MES^XPDUTL(" >> "_DGXR_" cross-reference filed.") "RTN","DG876PST",67,0) ;File DESCRIPTION field "RTN","DG876PST",68,0) D WP^DIE(.11,DGIEN(1)_",",.1,"","DGWP") "RTN","DG876PST",69,0) Q "RTN","DG876PST",70,0) ; "RTN","DG876PST",71,0) TEMPL(DGFILE,DGFLDS,DGFNAME) ;Determine templates on the file to be compiled. "RTN","DG876PST",72,0) N DGI "RTN","DG876PST",73,0) D BMES^XPDUTL("Beginning to compile templates on the "_DGFNAME_" (#"_DGFILE_") file.") "RTN","DG876PST",74,0) ; "RTN","DG876PST",75,0) F DGI=1:1:$L(DGFLDS,",") D LOOP($P(DGFLDS,",",DGI),DGFILE) "RTN","DG876PST",76,0) W !! "RTN","DG876PST",77,0) S (X,Y)="" "RTN","DG876PST",78,0) D:$D(CFIELD) "RTN","DG876PST",79,0) .D BMES^XPDUTL("The following routine namespace was compiled:") "RTN","DG876PST",80,0) .F S X=$O(CFIELD(X)) Q:X="" S Y=$G(Y)+1 S PRINT(Y)=" "_X_"*" "RTN","DG876PST",81,0) .D MES^XPDUTL(.PRINT) "RTN","DG876PST",82,0) D:'$D(CFIELD) "RTN","DG876PST",83,0) .D BMES^XPDUTL("No routine namespaces were needed to be compiled.") "RTN","DG876PST",84,0) K X,Y,PRINT,CFIELD "RTN","DG876PST",85,0) Q "RTN","DG876PST",86,0) LOOP(FIELD,FILE) ;Compile templates. "RTN","DG876PST",87,0) N GLOBAL,TEMPLATP,TEMPLATN,X,Y,DMAX "RTN","DG876PST",88,0) F GLOBAL="^DIE","^DIPT" DO "RTN","DG876PST",89,0) .I $D(@GLOBAL@("AF",FILE,FIELD)) D "RTN","DG876PST",90,0) ..S TEMPLATP=0 "RTN","DG876PST",91,0) ..F S TEMPLATP=$O(@GLOBAL@("AF",FILE,FIELD,TEMPLATP)) Q:'TEMPLATP DO "RTN","DG876PST",92,0) ...S TEMPLATN=$P($G(@GLOBAL@(TEMPLATP,0)),"^",1) "RTN","DG876PST",93,0) ...I TEMPLATN="" D BMES^XPDUTL("Could not compile template "_TEMPLATN_$C(13,10)_"Please review!") Q "RTN","DG876PST",94,0) ...S X=$P($G(@GLOBAL@(TEMPLATP,"ROUOLD")),"^") "RTN","DG876PST",95,0) ...I X=""&($D(@GLOBAL@(TEMPLATP,"ROU"))'=0) D BMES^XPDUTL("Could not find routine for template "_TEMPLATN_$C(13,10)_"Please review!") Q "RTN","DG876PST",96,0) ...I X=""&($D(@GLOBAL@(TEMPLATP,"ROU"))=0) Q "RTN","DG876PST",97,0) ...I $D(CFIELD(X)) Q ;already compiled "RTN","DG876PST",98,0) ...S CFIELD(X)="" ; remember the template was compiled "RTN","DG876PST",99,0) ...S Y=TEMPLATP ; set up the call for FileMan "RTN","DG876PST",100,0) ...S DMAX=$$ROUSIZE^DILF "RTN","DG876PST",101,0) ...I GLOBAL="^DIE" D BMES^XPDUTL(" "),BMES^XPDUTL(" Compiling Input Templates") D EN^DIEZ Q "RTN","DG876PST",102,0) ...I GLOBAL="^DIPT" D BMES^XPDUTL(" "),BMES^XPDUTL(" Compiling Print Templates") D EN^DIPZ Q "RTN","DG876PST",103,0) Q "RTN","DG876PST",104,0) ; "RTN","DG876PST",105,0) AUDIT(DGFILE,DGFLD,DGFNAME) ;Turn on Auditing for Field in File "RTN","DG876PST",106,0) D TURNON^DIAUTL(DGFILE,DGFLD) W !,"Adding AUDIT to file "_DGFILE_" "_DGFNAME_", field #"_DGFLD "RTN","DG876PST",107,0) Q "RTN","DG876PST",108,0) ; "RTN","DG876PST",109,0) EMPA31 ; queue off A31 messages on employees "RTN","DG876PST",110,0) ; "RTN","DG876PST",111,0) D BMES^XPDUTL(" "),BMES^XPDUTL(" Queuing job to update MPI for Employee Patients.") "RTN","DG876PST",112,0) I '$O(^DG(391,"B","EMPLOYEE",0)) D BMES^XPDUTL(" "),BMES^XPDUTL(" *** ERROR: EMPLOYEE entry not found in file 391 ***"),BMES^XPDUTL("*** Log a REMEDY ticket ***") Q "RTN","DG876PST",113,0) N ZTIO,ZTSK,ZTRTN,ZTDESC,ZTSAVE,ZTDTH,Y "RTN","DG876PST",114,0) S ZTIO="",ZTRTN="DQEMPA31^DG876PST",ZTDTH=$H "RTN","DG876PST",115,0) S ZTDESC="Send A31 update for Employee Patients-post init for DG*5.3*876" "RTN","DG876PST",116,0) D ^%ZTLOAD "RTN","DG876PST",117,0) I '$G(ZTSK) D MES^XPDUTL(" **** Queuing job failed!!!") Q "RTN","DG876PST",118,0) D MES^XPDUTL(" Job number "_ZTSK_" was queued.") "RTN","DG876PST",119,0) Q "RTN","DG876PST",120,0) DQEMPA31 ; Entry point to queue job to update Employee Patients "RTN","DG876PST",121,0) N DGSITE,DGSNAME,DGDFN,DGICN,DGCNT,DGECNT,DGERR,R,X,DGEMP "RTN","DG876PST",122,0) ; Get EMPLOYEE entry "RTN","DG876PST",123,0) S DGEMP=$O(^DG(391,"B","EMPLOYEE",0)) "RTN","DG876PST",124,0) ; Get current station number and name "RTN","DG876PST",125,0) S X=$$SITE^VASITE() "RTN","DG876PST",126,0) S DGSNAME=$P(X,"^",2),DGSITE=$P(X,"^",3) "RTN","DG876PST",127,0) S (DGCNT,DGECNT)=0 "RTN","DG876PST",128,0) ; Loop through patient file to find EMPLOYEE entries "RTN","DG876PST",129,0) S DGDFN=0 F S DGDFN=$O(^DPT("APTYPE",DGEMP,DGDFN)) Q:'DGDFN D "RTN","DG876PST",130,0) . ; Only update if station has a valid national ICN "RTN","DG876PST",131,0) . S DGICN=+$$GETICN^MPIF001(DGDFN) "RTN","DG876PST",132,0) . Q:DGICN=-1 "RTN","DG876PST",133,0) . Q:$E(DGICN,1,($L(DGSITE)))=DGSITE "RTN","DG876PST",134,0) . ; Send A31 "RTN","DG876PST",135,0) . S DGERR=$$A31^MPIFA31B(DGDFN) "RTN","DG876PST",136,0) . I +DGERR<0 D Q "RTN","DG876PST",137,0) .. D START^RGHLLOG() "RTN","DG876PST",138,0) .. D EXC^RGHLLOG(208,"Error building A31 for EMPLOYEE PATIENT during post-init of DG*5.3*876, (DFN="_DGDFN_"), ERROR="_$P(DGERR,"^",2),DGDFN) "RTN","DG876PST",139,0) .. D STOP^RGHLLOG() "RTN","DG876PST",140,0) .. S DGECNT=DGECNT+1 Q "RTN","DG876PST",141,0) . S DGCNT=DGCNT+1 "RTN","DG876PST",142,0) ; Send email to person who ran the INIT, letting them know results "RTN","DG876PST",143,0) N XMDUZ,XMTEXT,XMSUB,XMY,XMZ,XMDUN,X,R "RTN","DG876PST",144,0) S R(1)="A31 messages to update the EMPLOYEE PATIENTS for "_DGCNT_" were sent." "RTN","DG876PST",145,0) I DGECNT'>0 S R(2)=" ",R(3)="You can now delete the post-init routine ^DG876PST." "RTN","DG876PST",146,0) I DGECNT>0 D "RTN","DG876PST",147,0) . S R(2)=" " "RTN","DG876PST",148,0) . S R(3)="*** Note: "_DGECNT_" errors occurred trying to update the EMPLOYEE PATIENT." "RTN","DG876PST",149,0) . S R(4)="*** IMDQ can check the EXCEPTIONS LOG to see details for these errors." "RTN","DG876PST",150,0) . S R(5)="*** See further instructions in the patch description for DG*5.3*876." "RTN","DG876PST",151,0) S XMTEXT="R(",XMSUB="Results from running patch DG*5.3*876" "RTN","DG876PST",152,0) S XMDUZ=.5 "RTN","DG876PST",153,0) S XMY(DUZ)="" "RTN","DG876PST",154,0) D ^XMD "RTN","DG876PST",155,0) ; Send message to MPI developers on Outlook "RTN","DG876PST",156,0) K XMDUZ,XMTEXT,XMSUB,XMY,XMZ,XMDUN,R "RTN","DG876PST",157,0) S R(1)="Post-Init routine ^DG876PST run at station: "_DGSITE_" - "_DGSNAME "RTN","DG876PST",158,0) S R(2)=" " "RTN","DG876PST",159,0) S R(3)="A31 messages to update the EMPLOYEE PATIENTs for "_DGCNT_" records were sent." "RTN","DG876PST",160,0) I DGECNT>0 D "RTN","DG876PST",161,0) . S R(4)=" " "RTN","DG876PST",162,0) . S R(5)="*** Note: "_DGECNT_" errors occurred trying to update the EMPLOYEE PATIENTS." "RTN","DG876PST",163,0) . S R(6)="*** IMDQ can check the EXCEPTIONS LOG to see details for these errors." "RTN","DG876PST",164,0) . S R(7)="*** See further instructions in the patch description for DG*5.3*876." "RTN","DG876PST",165,0) S XMTEXT="R(",XMSUB="Results from running patch DG*5.3*876 at station: "_DGSITE "RTN","DG876PST",166,0) S XMDUZ=DUZ "RTN","DG876PST",167,0) S XMY("Christine.Chesney@domain.ext")="" "RTN","DG876PST",168,0) S XMY("John.Williams30ec0c@domain.ext")="" "RTN","DG876PST",169,0) S XMY("Ed.Zeigler@domain.ext")="" "RTN","DG876PST",170,0) D ^XMD "RTN","DG876PST",171,0) Q "RTN","DG876PST",172,0) ; "RTN","DPTLK") 0^4^B116067548^B114088511 "RTN","DPTLK",1,0) DPTLK ;ALB/RMO,RTK - MAS Patient Look-up Main Routine ; 3/22/05 4:19pm "RTN","DPTLK",2,0) ;;5.3;Registration;**32,72,93,73,136,157,197,232,265,277,223,327,244,513,528,541,576,600,485,633,629,647,769,857,876**;Aug 13, 1993;Build 6 "RTN","DPTLK",3,0) ; "RTN","DPTLK",4,0) ; mods made for magstripe read 12/96 - JFP "RTN","DPTLK",5,0) ; mods made for VIC 4.0 (barcode and magstripe) read 4/2012 - ELZ (*857) "RTN","DPTLK",6,0) ; "RTN","DPTLK",7,0) ;Optional input: DPTNOFZY='1' to suppress fuzzy lookups implemented "RTN","DPTLK",8,0) ; by patch DG*5.3*244 "RTN","DPTLK",9,0) ; "RTN","DPTLK",10,0) EN ; -- Entry point "RTN","DPTLK",11,0) N DIE,DR "RTN","DPTLK",12,0) K DPTX,DPTDFN,DPTSAVX I $D(DIC(0)) G QK:DIC(0)["I"!(DIC(0)'["A"&('$D(X))) "RTN","DPTLK",13,0) I '$D(^DD("VERSION")) W !!?3,"Unable to proceed. Fileman version node ^DD(""VERSION"") is undefined." G QK "RTN","DPTLK",14,0) I '$D(^DPT(0))!(^DD("VERSION")<17.2) W !!?3,"Unable to proceed. ",$S('$D(^DPT(0)):"0th node of ^DPT missing",^DD("VERSION")<17.2:"Fileman version must be at least 17.2",1:""),"." G QK "RTN","DPTLK",15,0) EN2 K DO,DUOUT,DTOUT S U="^",DIC="^DPT(",DIC(0)=$S($D(DIC(0)):DIC(0),1:"AELMQ") S:DIC(0)'["A" (DPTX,DPTSAVX)=X "RTN","DPTLK",16,0) S DPTSZ=1000 I $D(^DD("OS"))#2 S DPTSZ=$S(+$P(^DD("OS",^("OS"),0),U,2):$P(^(0),U,2),1:DPTSZ) "RTN","DPTLK",17,0) ; "RTN","DPTLK",18,0) ASKPAT ; -- Prompt for patient "RTN","DPTLK",19,0) I DIC(0)["A" D G QK:'$T!($E(DPTX)["^")!(DPTX="") "RTN","DPTLK",20,0) .K DTOUT,DUOUT,DGNEW "RTN","DPTLK",21,0) .W !,$S($D(DIC("A")):DIC("A"),1:"Select PATIENT NAME: ") W:$D(DIC("B")) DIC("B"),"// " "RTN","DPTLK",22,0) .R X:DTIME "RTN","DPTLK",23,0) .S DPTX=X S:'$T DTOUT=1 S:$T&(DPTX="")&($D(DIC("B"))) DPTX=DIC("B") S:DPTX["^"&($E(DPTX)'="%") DUOUT=1 "RTN","DPTLK",24,0) ; -- Check for the IATA magnetic stripe input "RTN","DPTLK",25,0) N MAG,GCHK,BARCODE,DGVIC40,DGCAC "RTN","DPTLK",26,0) S (MAG,BARCODE,DGVIC40,DGCAC)=0 "RTN","DPTLK",27,0) I $E(DPTX)="%"!($E(DPTX)=";"),DPTX["?" S MAG=1,(X,DPTX)=$$IATA(DPTX) "RTN","DPTLK",28,0) I 'MAG,DPTX?1"%"1N13ANP.3AN S BARCODE=1,(X,DPTX)=$$BARCODE($$UP^XLFSTR(DPTX)) "RTN","DPTLK",29,0) ; - read other line but don't use dbia#10096 don't display input "RTN","DPTLK",30,0) I $G(DGVIC40),'BARCODE X ^%ZOSF("EOFF") R X(1):1 X ^%ZOSF("EON") "RTN","DPTLK",31,0) I 'MAG,'BARCODE,DPTX?1N6AN1A7AN1A2AN S DGCAC=1,(X,DPTX)=$$CACCARD($$UP^XLFSTR(DPTX)) "RTN","DPTLK",32,0) ; fail VHIC card match but starts with %, we're done "RTN","DPTLK",33,0) I 'MAG,'BARCODE,'DGCAC,$E(DPTX,1)="%" G CHKDFN "RTN","DPTLK",34,0) ; "RTN","DPTLK",35,0) CHKPAT ; -- Custom Patient Lookup "RTN","DPTLK",36,0) D DO^DIC1 "RTN","DPTLK",37,0) S DIC("W")=$S($D(DIC("W")):DIC("W"),1:"") "RTN","DPTLK",38,0) K DPTIFNS,DPTS,DPTSEL "RTN","DPTLK",39,0) S DPTCNT=0 "RTN","DPTLK",40,0) ; -- Check input for format an length "RTN","DPTLK",41,0) G CHKDFN:DPTX?1A!(DPTX'?.ANP)!($L(DPTX)>30)&('$G(DGVIC40)) "RTN","DPTLK",42,0) ; -- Check for null response or abort "RTN","DPTLK",43,0) I DPTX=""!(DPTX["^") G ASKPAT:DIC(0)["A",QK "RTN","DPTLK",44,0) ; -- Check for question mark "RTN","DPTLK",45,0) I DPTX["?" D G ASKPAT:DIC(0)["A",QK "RTN","DPTLK",46,0) .S D="B" "RTN","DPTLK",47,0) .S DZ=$S(DPTX?1"?":"",1:"??") "RTN","DPTLK",48,0) .G CHKPAT1:DZ="??" "RTN","DPTLK",49,0) .N % "RTN","DPTLK",50,0) .W !,?1,"Answer with PATIENT NAME, or SOCIAL SECURITY NUMBER, or last 4 digits",!,?4,"of SOCIAL SECURITY NUMBER, or first initial of" "RTN","DPTLK",51,0) .W " last name with last",!,?4,"4 digits of SOCIAL SECURITY NUMBER" "RTN","DPTLK",52,0) .W !,?1,"Do you want the entire ",+$P($G(^DPT(0)),"^",4),"-Entry PATIENT List" S %=0 D YN^DICN "RTN","DPTLK",53,0) .Q:%'=1 "RTN","DPTLK",54,0) .S DZ="??" "RTN","DPTLK",55,0) CHKPAT1 .S X=DPTX "RTN","DPTLK",56,0) .D DQ^DICQ "RTN","DPTLK",57,0) ; -- Check for space bar, return "RTN","DPTLK",58,0) I DPTX=" " D G CHKDFN "RTN","DPTLK",59,0) .S Y=$S('($D(DUZ)#2):-1,$D(^DISV(DUZ,"^DPT(")):^("^DPT("),1:-1) "RTN","DPTLK",60,0) .D SETDPT^DPTLK1:Y>0 "RTN","DPTLK",61,0) .S DPTDFN=$S($D(DPTS(Y)):Y,1:-1) "RTN","DPTLK",62,0) ; -- Check for DFN look up "RTN","DPTLK",63,0) I $E(DPTX)="`" D G CHKDFN "RTN","DPTLK",64,0) .S Y=$S($D(^DPT(+$P(DPTX,"`",2),0)):+$P(DPTX,"`",2),1:-1) "RTN","DPTLK",65,0) .D SETDPT^DPTLK1:Y>0 "RTN","DPTLK",66,0) .S DPTDFN=$S($D(DPTS(Y)):Y,1:-1) "RTN","DPTLK",67,0) ; -- Puts input in correct format "RTN","DPTLK",68,0) G CHKDFN:DPTX="" "RTN","DPTLK",69,0) ; -- Force new entry "RTN","DPTLK",70,0) I $E(DPTX)="""",$E(DPTX,$L(DPTX))="""" G NOPAT "RTN","DPTLK",71,0) ; -- Check for EDIPI lookup "RTN","DPTLK",72,0) I DPTX?10N,DIC(0)["M" D G:$G(DPTDFN)>0 CHKDFN "RTN","DPTLK",73,0) .N DGEDIPI "RTN","DPTLK",74,0) .S DGEDIPI=0 F S DGEDIPI=$O(^DGCN(391.91,"AISS",DPTX,"USDOD","NI",+$$IEN^XUAF4("200DOD"),DGEDIPI)) Q:'DGEDIPI I $P($G(^DGCN(391.91,DGEDIPI,2)),"^",3)'="H" Q "RTN","DPTLK",75,0) .Q:DGEDIPI<1 "RTN","DPTLK",76,0) .S Y=$P($G(^DGCN(391.91,DGEDIPI,0)),"^") "RTN","DPTLK",77,0) .D SETDPT^DPTLK1:Y>0 "RTN","DPTLK",78,0) .S DPTDFN=$S($D(DPTS(Y)):Y,1:-1) "RTN","DPTLK",79,0) ; -- Check for index lookups "RTN","DPTLK",80,0) I '$G(DGVIC40)!(DPTX?9N) D ^DPTLK1 G QK:$D(DTOUT)!($D(DUOUT)&(DIC(0)'["A")),ASKPAT:$D(DUOUT),CHKPAT:DPTDFN<0,CHKDFN:DPTDFN>0 I DIC(0)["N",$D(^DPT(DPTX,0)) S Y=X D SETDPT^DPTLK1 S DPTDFN=$S($D(DPTS(Y)):Y,1:-1) G CHKDFN "RTN","DPTLK",81,0) MAG ; -- No patient found, check for mag stripe input, create stub "RTN","DPTLK",82,0) I 'MAG,'BARCODE,'DGCAC G NOPAT "RTN","DPTLK",83,0) ; -- Check for ADT option(s) only "RTN","DPTLK",84,0) N DGOPT "RTN","DPTLK",85,0) S DGOPT=$P($G(XQY0),"^",2) "RTN","DPTLK",86,0) I DGOPT'="Load/Edit Patient Data",DGOPT'="Register a Patient" D G EN2 "RTN","DPTLK",87,0) .W !," ...Patient not in database, use ADT options to load patient" D Q1 "RTN","DPTLK",88,0) ; -- Prompt for creation of stub "RTN","DPTLK",89,0) S DIR(0)="Y",DIR("B")="NO",DIR("A")="Patient not found...Create stub entry: " "RTN","DPTLK",90,0) S GCHK=$D(^TMP("DGVIC")) "RTN","DPTLK",91,0) D ^DIR "RTN","DPTLK",92,0) K DIR "RTN","DPTLK",93,0) I 'Y D Q1 G EN2 "RTN","DPTLK",94,0) ; -- Parse IATA fields "RTN","DPTLK",95,0) D @$S(DGVIC40:"VIC40(.DGFLDS,DGVIC40,DGCAC)",1:"FIELDS(IATA)") "RTN","DPTLK",96,0) I '$D(@DGFLDS) W !,"Could not add patient to patient file" D Q1 G EN2 "RTN","DPTLK",97,0) ; -- Check for Duplicates, no checking if VIC 4.0 card or CAC card "RTN","DPTLK",98,0) D:'$G(DGVIC40) EP2^DPTLK3 "RTN","DPTLK",99,0) ; -- No check done on VIC 4.0 or CAC card, so skip DPTDFN value "RTN","DPTLK",100,0) ; check, file record "RTN","DPTLK",101,0) I 'DGVIC40,DPTDFN<0 D Q1 G EN2 "RTN","DPTLK",102,0) ; -- Creates Stub entry in patient file "RTN","DPTLK",103,0) S Y=$$FILE^DPTLK4(DGFLDS,$G(DGVIC40)) "RTN","DPTLK",104,0) I $P(Y,"^",3)'=1 W !,"Could not add patient to patient file" D QK1 Q "RTN","DPTLK",105,0) D QK1 "RTN","DPTLK",106,0) Q "RTN","DPTLK",107,0) ; "RTN","DPTLK",108,0) NOPAT ; -- No patient found, ask to add new "RTN","DPTLK",109,0) I DIC(0)["L" D ^DPTLK2 S Y=DPTDFN G ASKPAT:DIC(0)["A"&(Y<0)&('$G(DTOUT)),QK1 "RTN","DPTLK",110,0) ; "RTN","DPTLK",111,0) CHKDFN ; -- "RTN","DPTLK",112,0) S:'$D(DPTDFN) DPTDFN=-1 I DPTDFN'>0!('$D(DPTS(+DPTDFN))) W:DIC(0)["Q" *7," ??" G ASKPAT:DIC(0)["A",QK "RTN","DPTLK",113,0) I DIC(0)["E" D W $S('$D(DPTSEL)&('$D(DIVP)):$P(DPTS(DPTDFN),U,2)_" "_$P(DPTS(DPTDFN),U)_" ",$D(^DPT(DPTDFN,0)):" "_$P(^(0),U)_" ",1:"") S Y=DPTDFN X:$D(^DPT(DPTDFN,0)) "N DDS X DIC(""W"")" "RTN","DPTLK",114,0) .I $D(DDS) D CLRMSG^DDS S DX=0,DY=DDSHBX+1 X DDXY "RTN","DPTLK",115,0) ; "RTN","DPTLK",116,0) ; check for other patients in "BS5" xref on Patient file "RTN","DPTLK",117,0) ;I '$G(DICR),DPTDFN>0,DIC(0)["E",$$BS5^DPTLK5(+DPTDFN) D G ASKPAT:DIC(0)["A"&(%'=1),QK:DPTDFN<0 "RTN","DPTLK",118,0) I DPTDFN>0,DIC(0)["E",$$BS5^DPTLK5(+DPTDFN) D G ASKPAT:DIC(0)["A"&(%'=1),QK:DPTDFN<0 ;*TEST* "RTN","DPTLK",119,0) .N DPTZERO,DPTLSNME,DPTSSN S DPTZERO=$G(^DPT(+DPTDFN,0)),DPTLSNME=$P($P(DPTZERO,U),","),DPTSSN=$E($P(DPTZERO,U,9),6,9) "RTN","DPTLK",120,0) .W $C(7),!!,"There is more than one patient whose last name is '",DPTLSNME,"' and" "RTN","DPTLK",121,0) .W !,"whose social security number ends with '",DPTSSN,"'." "RTN","DPTLK",122,0) .W !,"Are you sure you wish to continue (Y/N)" S %=0 D YN^DICN "RTN","DPTLK",123,0) .I %'=1 S DPTDFN=-1 "RTN","DPTLK",124,0) ; "RTN","DPTLK",125,0) ;I '$G(DICR),DPTDFN>0 S Y=DPTDFN D ^DGSEC S DPTDFN=Y G ASKPAT:DIC(0)["A"&(DPTDFN<0),QK:DPTDFN<0 "RTN","DPTLK",126,0) I DPTDFN>0,DIC(0)["E" S Y=DPTDFN D ^DGSEC S DPTDFN=Y G ASKPAT:DIC(0)["A"&(DPTDFN<0),QK:DPTDFN<0 S DPTBTDT=1 "RTN","DPTLK",127,0) S DPTX=DPTX_$P(DPTS(DPTDFN),U,2),DPTDFN=DPTDFN_U_$P(^DPT(DPTDFN,0),U) "RTN","DPTLK",128,0) ; "RTN","DPTLK",129,0) Q ; -- "RTN","DPTLK",130,0) S Y=$S('$D(DPTDFN):-1,'$D(DPTS(+DPTDFN)):-1,1:DPTDFN),X=$S($D(DPTX)&(+Y>0):DPTX,$D(DPTSAVX):DPTSAVX,$D(DPTX):DPTX,1:"") "RTN","DPTLK",131,0) I Y>0 S:DIC(0)'["F" ^DISV($S($D(DUZ)#2:DUZ,1:0),"^DPT(")=+Y S:DIC(0)["Z" Y(0)=^DPT(+Y,0),Y(0,0)=$P(^(0),U,1) "RTN","DPTLK",132,0) ;DG*600 "RTN","DPTLK",133,0) ;I DIC(0)["E",$P($G(^DPT(+Y,0)),U,21) W *7,!,"Warning : You have selected a test patient." "RTN","DPTLK",134,0) I DIC(0)["E",$$TESTPAT^VADPT(+Y) W *7,!,"WARNING : You may have selected a test patient." "RTN","DPTLK",135,0) I DIC(0)["E",$$BADADR^DGUTL3(+Y) W *7,!,"WARNING : ** This patient has been flagged with a Bad Address Indicator." "RTN","DPTLK",136,0) I DIC(0)["E",$$VAADV^DPTLK3(+Y) W *7,!,"** Patient is VA ADVANTAGE." "RTN","DPTLK",137,0) ;DG*485 "RTN","DPTLK",138,0) I $D(^DPT("AXFFP",1,+Y)) D FFP^DPTLK5 "RTN","DPTLK",139,0) ;Display enrollment information "RTN","DPTLK",140,0) I Y>0,DIC(0)["E" D ENR "RTN","DPTLK",141,0) ; "RTN","DPTLK",142,0) ;Call Combat Vet check "RTN","DPTLK",143,0) I Y>0,DIC(0)["E" D CV "RTN","DPTLK",144,0) ; "RTN","DPTLK",145,0) ; check whether to display Means Test Required message "RTN","DPTLK",146,0) D "RTN","DPTLK",147,0) .N DPTDIV "RTN","DPTLK",148,0) .I '$G(DUZ(2)) Q "RTN","DPTLK",149,0) .I Y>0,DIC(0)["E" S DPTDIV=$$DMT^DPTLK5(+Y,DUZ(2)) I DPTDIV D "RTN","DPTLK",150,0) ..W $C(7),!!,"MEANS TEST REQUIRED" "RTN","DPTLK",151,0) ..W !,?3,$P($G(^DG(40.8,DPTDIV,"MT")),U,2) "RTN","DPTLK",152,0) ..H 2 "RTN","DPTLK",153,0) ; "RTN","DPTLK",154,0) Q1 ; -- Clean up variables "RTN","DPTLK",155,0) K D,DIC("W"),DO,DPTCNT,DPTDFN,DPTIFNS,DPTIX,DPTS "RTN","DPTLK",156,0) K:'$G(DICR) DPTBTDT ; IF DICR LEAVE FOR DGSEC TO HANDLE "RTN","DPTLK",157,0) K DPTSAVX,DPTSEL,DPTSZ,DPTX "RTN","DPTLK",158,0) ; "RTN","DPTLK",159,0) K:$D(IATA) IATA "RTN","DPTLK",160,0) K:$D(DGFLDS) @DGFLDS,DGFLDS "RTN","DPTLK",161,0) Q "RTN","DPTLK",162,0) ; "RTN","DPTLK",163,0) QK K:'$D(DPTNOFZK) DPTNOFZY G Q "RTN","DPTLK",164,0) ; "RTN","DPTLK",165,0) QK1 K:'$D(DPTNOFZK) DPTNOFZY G Q1 "RTN","DPTLK",166,0) ; "RTN","DPTLK",167,0) IX ; -- "RTN","DPTLK",168,0) I $D(D),$D(^DD(2,0,"IX",D)),($E(D)'="A") S DPTIX=D "RTN","DPTLK",169,0) G DPTLK "RTN","DPTLK",170,0) ; "RTN","DPTLK",171,0) IATA(X) ; -- "RTN","DPTLK",172,0) ;This function pulls off ssn from the IATA track (old card) "RTN","DPTLK",173,0) ; - If new card, then use card number to look-up DFN, returned as `DFN "RTN","DPTLK",174,0) ; "RTN","DPTLK",175,0) ;Input: X - what was read in "RTN","DPTLK",176,0) ;Output: SSN - social security number OR `DFN if new card "RTN","DPTLK",177,0) ; Q - quit "RTN","DPTLK",178,0) ; "RTN","DPTLK",179,0) ; Track Start Sent End Sent Field Separator "RTN","DPTLK",180,0) ; ----- ---------- -------- --------------- "RTN","DPTLK",181,0) ; IATA (alphanum) % ? { (Note: VA used ^) "RTN","DPTLK",182,0) ; ABA (numeric) ; ? = "RTN","DPTLK",183,0) ; "RTN","DPTLK",184,0) ;N IATA "RTN","DPTLK",185,0) S (IATA)="" "RTN","DPTLK",186,0) I $E(X)'="%" Q X ; no start sentinel "RTN","DPTLK",187,0) I X'["?" Q "Q" "RTN","DPTLK",188,0) ; -- Extract data from track "RTN","DPTLK",189,0) S IATA=$$TRACK(X,"%","?") "RTN","DPTLK",190,0) ; -- checks for no data "RTN","DPTLK",191,0) I IATA="" Q "Q" "RTN","DPTLK",192,0) ; -- checks for new card, look-up DFN "RTN","DPTLK",193,0) I $E(X,1,29)?1"%"9NP1"^"17UNP1"?" S IATA=$$CARD(+$P($P(X,"%",2),"^")) "RTN","DPTLK",194,0) ; -- Returns SSN or `DFN value "RTN","DPTLK",195,0) I IATA'="" Q $P(IATA,"^") "RTN","DPTLK",196,0) Q "Q" "RTN","DPTLK",197,0) ; "RTN","DPTLK",198,0) TRACK(X,START,END) ; find track where start/end are sentinels "RTN","DPTLK",199,0) ; "RTN","DPTLK",200,0) Q $P($P($G(X),START,2),END,1) "RTN","DPTLK",201,0) ; "RTN","DPTLK",202,0) FIELDS(IATA) ; -- Sets fields "RTN","DPTLK",203,0) Q:'$D(IATA) "RTN","DPTLK",204,0) N CNT,FIELD "RTN","DPTLK",205,0) S DGFLDS="^TMP(""DGVIC"","_$J_")",CNT=1 "RTN","DPTLK",206,0) K @DGFLDS "RTN","DPTLK",207,0) F S FIELD=$P($G(IATA),"^",CNT) Q:FIELD="" D "RTN","DPTLK",208,0) .S @DGFLDS@(CNT)=FIELD "RTN","DPTLK",209,0) .S CNT=CNT+1 "RTN","DPTLK",210,0) ; -- Define fields for duplicate checker "RTN","DPTLK",211,0) S DPTX=$G(@DGFLDS@(2)) ;NAME "RTN","DPTLK",212,0) S DPTIDS(.03)=$G(@DGFLDS@(3)) ;DOB "RTN","DPTLK",213,0) S DPTIDS(.09)=$G(@DGFLDS@(1)) ;SSN "RTN","DPTLK",214,0) Q "RTN","DPTLK",215,0) BARCODE(X) ; "RTN","DPTLK",216,0) ;This function pulls off card number from the barcode scan "RTN","DPTLK",217,0) ; looks up the patient (locally) "RTN","DPTLK",218,0) ; if not locally found, queries mpi "RTN","DPTLK",219,0) ; "RTN","DPTLK",220,0) ;Input: X - what was read in "RTN","DPTLK",221,0) ;Output: DFN - `DFN "RTN","DPTLK",222,0) ; Q - quit "RTN","DPTLK",223,0) ; "RTN","DPTLK",224,0) ; Input Start Data VIC ver DoD EDI_PIN VA/VIC II "RTN","DPTLK",225,0) ; -------- ---------- ------- ----------- ---------- "RTN","DPTLK",226,0) ; alphanum % N alphanum 7 alphanum 6 "RTN","DPTLK",227,0) ; "RTN","DPTLK",228,0) N CARD "RTN","DPTLK",229,0) S CARD=$$B32TO10($E(X,10,15)) I 'CARD Q "Q" "RTN","DPTLK",230,0) Q $$CARD(CARD) "RTN","DPTLK",231,0) ; "RTN","DPTLK",232,0) CACCARD(X) ; "RTN","DPTLK",233,0) ;This function pulls off EDIPI number from the CAC barcode scan "RTN","DPTLK",234,0) ; looks up the patient (locally) "RTN","DPTLK",235,0) ; if not locally found, queries mpi "RTN","DPTLK",236,0) ; "RTN","DPTLK",237,0) ;Input: X - what was read in "RTN","DPTLK",238,0) ;Output: DFN - `DFN "RTN","DPTLK",239,0) ; Q - quit "RTN","DPTLK",240,0) ; "RTN","DPTLK",241,0) ; VC PDI PT DoD EDI PC BC CI "RTN","DPTLK",242,0) ; -- --- -- ------- -- --- --- "RTN","DPTLK",243,0) ; "1" 6UN 1U 7UN 1U 1UN 1UN "RTN","DPTLK",244,0) ; "RTN","DPTLK",245,0) N EDIPI "RTN","DPTLK",246,0) S EDIPI=$$B32TO10($E(X,9,15)) I 'EDIPI Q "Q" "RTN","DPTLK",247,0) Q $$EDIPI(EDIPI) "RTN","DPTLK",248,0) ; "RTN","DPTLK",249,0) EDIPI(EDIPI) ; - returns `DFN from EDIPI number "RTN","DPTLK",250,0) N DFN,VICFAC "RTN","DPTLK",251,0) S VICFAC=+$$LKUP^XUAF4("200DOD") ; national DOD station number "RTN","DPTLK",252,0) S DFN=+$G(^DGCN(391.91,+$O(^DGCN(391.91,"ASID",EDIPI,VICFAC,0)),0)) "RTN","DPTLK",253,0) S DGVIC40=EDIPI ; saving EDIPI number here so I don't have to look later "RTN","DPTLK",254,0) I DFN Q "`"_DFN "RTN","DPTLK",255,0) ; - not found locally, need to make sure we don't find anyone DGVIC40 "RTN","DPTLK",256,0) Q "Q" "RTN","DPTLK",257,0) CARD(CARD) ; - returns `DFN from card number "RTN","DPTLK",258,0) N DFN,VICFAC "RTN","DPTLK",259,0) S VICFAC=+$$LKUP^XUAF4("742V1") ; national vic facility number "RTN","DPTLK",260,0) S DFN=+$G(^DGCN(391.91,+$O(^DGCN(391.91,"ASID",CARD,VICFAC,0)),0)) "RTN","DPTLK",261,0) S DGVIC40=CARD ; saving card number here so I don't have to look later "RTN","DPTLK",262,0) I DFN Q "`"_DFN "RTN","DPTLK",263,0) ; - not found locally, need to make sure we don't find anyone DGVIC40 "RTN","DPTLK",264,0) Q "Q" "RTN","DPTLK",265,0) VIC40(DGFLDS,DGVIC40,DGCAC) ; - returns the data used to create the "RTN","DPTLK",266,0) ; patient file entry from mpi "RTN","DPTLK",267,0) N X,DGMPI "RTN","DPTLK",268,0) S DGFLDS="^TMP(""DGVIC"","_$J_")" "RTN","DPTLK",269,0) K @DGFLDS "RTN","DPTLK",270,0) I $T(CARDPV^MPIFXMLS)'="" D CARDPV^MPIFXMLS(.DGMPI,DGVIC40,DGCAC) "RTN","DPTLK",271,0) S X=0 F S X=$O(DGMPI(X)) Q:'X S @DGFLDS@(X)=DGMPI(X) "RTN","DPTLK",272,0) Q "RTN","DPTLK",273,0) ENR ;Display Enrollment information after patient selection "RTN","DPTLK",274,0) N DGENCAT,DGENDFN,DGENR,DGEGTIEN,DGEGT "RTN","DPTLK",275,0) I '$$GET^DGENA($$FINDCUR^DGENA(+DPTDFN),.DGENR) Q "RTN","DPTLK",276,0) S DGENCAT=$$CATEGORY^DGENA4(+DPTDFN) "RTN","DPTLK",277,0) S DGENCAT=$$EXTERNAL^DILFD(27.15,.02,"",DGENCAT) "RTN","DPTLK",278,0) W !?1,"Enrollment Priority: ",$S($G(DGENR("PRIORITY")):$$EXT^DGENU("PRIORITY",DGENR("PRIORITY")),1:""),$S($G(DGENR("SUBGRP"))="":"",1:$$EXT^DGENU("SUBGRP",$G(DGENR("SUBGRP")))) "RTN","DPTLK",279,0) W ?33,"Category: ",DGENCAT "RTN","DPTLK",280,0) W ?57,"End Date: ",$S($G(DGENR("END")):$$FMTE^XLFDT(DGENR("END"),"5DZ"),1:""),! "RTN","DPTLK",281,0) ;If patient is NOT ELIGIBLE, display Enrollment Status (Ineligible Project Phase I) "RTN","DPTLK",282,0) I $G(DGENR("STATUS"))=10!($G(DGENR("STATUS"))=19)!($G(DGENR("STATUS"))=20) D "RTN","DPTLK",283,0) . W ?1,"Enrollment Status: ",$S($G(DGENR("STATUS")):$$EXT^DGENU("STATUS",DGENR("STATUS")),1:"") ;H 5 "RTN","DPTLK",284,0) ;check for Combat Veteran Eligibility, if elig do not display EGT info "RTN","DPTLK",285,0) I $$CVEDT^DGCV(+DPTDFN) Q "RTN","DPTLK",286,0) ;Get Enrollment Group Threshold Priority and Subgroup "RTN","DPTLK",287,0) S DGEGTIEN=$$FINDCUR^DGENEGT "RTN","DPTLK",288,0) S DGEGT=$$GET^DGENEGT(DGEGTIEN,.DGEGT) "RTN","DPTLK",289,0) Q:$G(DGENR("PRIORITY"))=""!($G(DGEGT("PRIORITY"))="") "RTN","DPTLK",290,0) ;Compare Patient's Enrollment Priority to Enrollment Group Threshold "RTN","DPTLK",291,0) I '$$ABOVE^DGENEGT1(+DPTDFN,DGENR("PRIORITY"),$G(DGENR("SUBGRP")),DGEGT("PRIORITY"),DGEGT("SUBGRP")) D "RTN","DPTLK",292,0) .N X,IORVOFF,IORVON "RTN","DPTLK",293,0) .S X="IORVOFF;IORVON" "RTN","DPTLK",294,0) .D ENDR^%ZISS "RTN","DPTLK",295,0) .W !?32 W:$D(IORVON) IORVON W "*** WARNING ***" W:$D(IORVOFF) IORVOFF "RTN","DPTLK",296,0) .I DGENR("END")'="" W !?14 W:$D(IORVON) IORVON W "*** PATIENT ENROLLMENT END",$S(DT>+DGENR("END"):"ED",1:"S")," EFFECTIVE ",$$FMTE^XLFDT(DGENR("END"),"5DZ")," ***" W:$D(IORVOFF) IORVOFF Q "RTN","DPTLK",297,0) .W !?5 W:$D(IORVON) IORVON W "*** PATIENT ENROLLMENT ENDING. ENROLLMENT END DATE IS NOT KNOWN. ***" W:$D(IORVOFF) IORVOFF "RTN","DPTLK",298,0) Q "RTN","DPTLK",299,0) CV ;check for Combat Vet status "RTN","DPTLK",300,0) N DGCV "RTN","DPTLK",301,0) S DGCV=$$CVEDT^DGCV(+DPTDFN) "RTN","DPTLK",302,0) I $P(DGCV,U)=1 D Q "RTN","DPTLK",303,0) . I '$$GET^DGENA($$FINDCUR^DGENA(+DPTDFN),.DGENR) W ! "RTN","DPTLK",304,0) . W ?3,"Combat Vet Status: "_$S($P(DGCV,U,3)=1:"ELIGIBLE",1:"EXPIRED"),?57,"End Date: "_$$FMTE^XLFDT($P(DGCV,U,2),"5DZ") "RTN","DPTLK",305,0) Q "RTN","DPTLK",306,0) B32TO10(X) ; - convert from base 32 to base 10 "RTN","DPTLK",307,0) N I,Y,S S Y=0,S="0123456789ABCDEFGHIJKLMNOPQRSTUV" "RTN","DPTLK",308,0) I X[" " S X=$E(X,1,$F(X," ")-2) "RTN","DPTLK",309,0) F I=1:1:$L(X) S Y=Y*32+($F(S,$E(X,I))-2) "RTN","DPTLK",310,0) Q Y "RTN","DPTLK",311,0) RPCVIC(RETURN,DPTX) ; - patient lookup from VIC card, rpc/api "RTN","DPTLK",312,0) ; non-interactive "RTN","DPTLK",313,0) ; this function will return a patient's DFN based on input. input must "RTN","DPTLK",314,0) ; be in the form of the FULL input from a VIC card (magstripe or bar "RTN","DPTLK",315,0) ; code), the patient must be locally known (FULL doesn't but can contain "RTN","DPTLK",316,0) ; additional card tracks) "RTN","DPTLK",317,0) ; RETURN input should be passed by reference "RTN","DPTLK",318,0) ; "RTN","DPTLK",319,0) ; Input examples: "RTN","DPTLK",320,0) ; Barcode possibilities: "RTN","DPTLK",321,0) ; NNNNNNNNN (old VIC card, full 9 digit ssn) "RTN","DPTLK",322,0) ; CCCCCCCCCCCCCCCCCC (new VIC 4.0 card, 18 characters with "RTN","DPTLK",323,0) ; 10-15 being compressed card number) "RTN","DPTLK",324,0) ; Magstripe possibilities: "RTN","DPTLK",325,0) ; Must always start with % "RTN","DPTLK",326,0) ; Must contain ? "RTN","DPTLK",327,0) ; $E(X,2,10) = SSN (old card) "RTN","DPTLK",328,0) ; %NNNNNNNNN^CCCCCCCCCCCCCCCCC? (first 29 characters) where "RTN","DPTLK",329,0) ; N = card number (new card) "RTN","DPTLK",330,0) ; "RTN","DPTLK",331,0) ; Return (pass by reference): If patient known locally = DFN "RTN","DPTLK",332,0) ; If not known locally = -1 "RTN","DPTLK",333,0) ; "RTN","DPTLK",334,0) N MAG,BARCODE "RTN","DPTLK",335,0) S (RETURN,MAG,BARCODE)=0 "RTN","DPTLK",336,0) I '$D(DPTX) Q -1 "RTN","DPTLK",337,0) S DPTX=$$UP^XLFSTR(DPTX) "RTN","DPTLK",338,0) I DPTX["?" S DPTX=$E(DPTX,1,$F(DPTX,"?")-1) "RTN","DPTLK",339,0) I DPTX?9N S RETURN=$O(^DPT("SSN",DPTX,0)) "RTN","DPTLK",340,0) I $E(DPTX)="%"!($E(DPTX)=";"),DPTX["?",'RETURN S MAG=1,DPTX=$$IATA(DPTX) "RTN","DPTLK",341,0) I 'MAG,DPTX?1"%"1N13UNP.3UN,'RETURN S BARCODE=1,DPTX=$$BARCODE(DPTX) "RTN","DPTLK",342,0) I 'MAG,'BARCODE,DPTX?1N6UN1U7UN1U2UN S DPTX=$$CACCARD(DPTX) "RTN","DPTLK",343,0) I 'RETURN,$E(DPTX,2,999) S RETURN=$S($E(DPTX)="`":$E(DPTX,2,999),1:$O(^DPT("SSN",DPTX,0))) "RTN","DPTLK",344,0) S RETURN=$S(RETURN:RETURN,1:-1) "RTN","DPTLK",345,0) Q "RTN","VAFCPDAT") 0^2^B52025374^B50668087 "RTN","VAFCPDAT",1,0) VAFCPDAT ;BIR/CML/ALS-DISPLAY MPI/PD INFORMATION FOR SELECTED PATIENT ;10/24/02 13:13 "RTN","VAFCPDAT",2,0) ;;5.3;Registration;**333,414,474,505,707,712,837,863,876**;Aug 13, 1993;Build 6 "RTN","VAFCPDAT",3,0) ;Registration has IA #3299 for MPI/PD to call START^VAFCPDAT "RTN","VAFCPDAT",4,0) ; "RTN","VAFCPDAT",5,0) ;variable DFN is not NEWed or KILLed in this routine as that variable is passed in "RTN","VAFCPDAT",6,0) ; "RTN","VAFCPDAT",7,0) MAIN ; Entry point with device call "RTN","VAFCPDAT",8,0) S NOTRPC=1 "RTN","VAFCPDAT",9,0) K ZTSAVE S ZTSAVE("DFN")="" "RTN","VAFCPDAT",10,0) D EN^XUTMDEVQ("START^VAFCPDAT","Print MPI/PD Patient Data",.ZTSAVE) "RTN","VAFCPDAT",11,0) K NOTRPC "RTN","VAFCPDAT",12,0) Q "RTN","VAFCPDAT",13,0) ; "RTN","VAFCPDAT",14,0) START ;Entry point without device call, used for RPC calls "RTN","VAFCPDAT",15,0) N X S X="MPIF001" X ^%ZOSF("TEST") I '$T W !,"MPI not installed." G QUIT ;**863 - MVI_2351 (ptd) "RTN","VAFCPDAT",16,0) S $P(LN,"=",80)="",$P(LN2,"=",60)="",QFLG=0 "RTN","VAFCPDAT",17,0) D NOW^%DTC S HDT=$$FMTE^XLFDT($E(%,1,12)) "RTN","VAFCPDAT",18,0) S SITE=$$SITE^VASITE(),SITENAM=$P(SITE,"^",2),SITENUM=$P(SITE,"^",3),SITEIEN=$P(SITE,"^") "RTN","VAFCPDAT",19,0) I +DFN<0 D Q "RTN","VAFCPDAT",20,0) .I $D(NOTRPC) W @IOF,!," " "RTN","VAFCPDAT",21,0) .W !,"ICN ",$G(ICN)," does not exist at ",SITENAM,"." "RTN","VAFCPDAT",22,0) .W !,"Search date: ",HDT,!,LN "RTN","VAFCPDAT",23,0) S DIC=2,DR=".01;.02;.03;.09;.111;.112;.113;.114;.115;.1112;.131;.313;.351;994;.0907;.0906;.121;.1171;.1172;.1173;.024",DA=DFN,DIQ(0)="EI",DIQ="DNODE" ;**707,712,863,876 "RTN","VAFCPDAT",24,0) N NAME,SSN,DOB,SEX,CLAIM,DOD,ICN,STR1,STR2,STR3,CTY,ST,ZIP,PHN,MBI,SSNVER,PREAS,BAI,TIN,FIN,COUNTRY,CCODE,CNAME,PROVINCE,POSTCODE,SIGEN ;**707,712,837,863,876 "RTN","VAFCPDAT",25,0) D EN^DIQ1 K DIC,DR,DA,DIQ "RTN","VAFCPDAT",26,0) S NAME=$G(DNODE(2,DFN,.01,"E")),SSN=$G(DNODE(2,DFN,.09,"E")) "RTN","VAFCPDAT",27,0) S DOB=$$FMTE^XLFDT($G(DNODE(2,DFN,.03,"I"))) "RTN","VAFCPDAT",28,0) S MBI=$G(DNODE(2,DFN,994,"I")),MBI=$S(MBI="Y":"YES",MBI="N":"NO",1:"NULL") ;**707 "RTN","VAFCPDAT",29,0) S SEX=$G(DNODE(2,DFN,.02,"E")),SIGEN=$G(DNODE(2,DFN,.024,"I")),DOD=$G(DNODE(2,DFN,.351,"E")) ;**876 - MVI_3432 (cml) "RTN","VAFCPDAT",30,0) S CLAIM=$G(DNODE(2,DFN,.313,"E")) S:CLAIM="" CLAIM="None" "RTN","VAFCPDAT",31,0) S BAI=$G(DNODE(2,DFN,.121,"E")) ;**712 "RTN","VAFCPDAT",32,0) S STR1=$G(DNODE(2,DFN,.111,"E")),STR2=$G(DNODE(2,DFN,.112,"E")),STR3=$G(DNODE(2,DFN,.113,"E")) "RTN","VAFCPDAT",33,0) S CTY=$G(DNODE(2,DFN,.114,"E")),ST=$G(DNODE(2,DFN,.115,"E")),ZIP=$G(DNODE(2,DFN,.1112,"E")) "RTN","VAFCPDAT",34,0) S COUNTRY=$G(DNODE(2,DFN,.1173,"I")),(CCODE,CNAME)="" I COUNTRY]"" S CCODE=$$GET1^DIQ(779.004,+COUNTRY_",",.01),CNAME=$$GET1^DIQ(779.004,+COUNTRY_",",1.3) ;**863 - MVI_1902 (ptd) "RTN","VAFCPDAT",35,0) S PROVINCE=$G(DNODE(2,DFN,.1171,"E")),POSTCODE=$G(DNODE(2,DFN,.1172,"E")) "RTN","VAFCPDAT",36,0) S PHN=$G(DNODE(2,DFN,.131,"E")) "RTN","VAFCPDAT",37,0) S SSNVER=$G(DNODE(2,DFN,.0907,"E")) ;**707 "RTN","VAFCPDAT",38,0) S PREAS=$G(DNODE(2,DFN,.0906,"E")) ;**707 "RTN","VAFCPDAT",39,0) S MNODE=$$MPINODE^MPIFAPI(DFN) I +MNODE=-1 S MNODE="^^^^^^^^" "RTN","VAFCPDAT",40,0) S (ICN,SCN,SCORE,SCRDT,DIFF,TIN,FIN)="" ;**837, MVI_883 "RTN","VAFCPDAT",41,0) S ICN=$$GETICN^MPIF001(DFN) S:(+ICN=-1) ICN="None" ;**863 - MVI_2351 (ptd) "RTN","VAFCPDAT",42,0) ;S CMOR=$$GET1^DIQ(4,+$P($G(MNODE),"^",3)_",",.01) S:CMOR="" CMOR="None" ;removed for **837, MVI_918 "RTN","VAFCPDAT",43,0) I $E(ICN,1,3)=SITENUM S GOT=0 D "RTN","VAFCPDAT",44,0) . I $P($G(MNODE),"^",4)=""!('$D(^DPT("AICNL",1,DFN))) S ICN=ICN_"**" "RTN","VAFCPDAT",45,0) S TIN=$P($G(MNODE),"^",8),FIN=$P($G(MNODE),"^",9) ;**837, MVI_883 "RTN","VAFCPDAT",46,0) ; "RTN","VAFCPDAT",47,0) I $D(NOTRPC) W @IOF,! "RTN","VAFCPDAT",48,0) W !,"MPI/PD Data for: ",NAME," (DFN #",DFN,")" "RTN","VAFCPDAT",49,0) ; check for patient sensitivity and user security "RTN","VAFCPDAT",50,0) N RESULT,RGSENS,SENSTV,DA,DR,DIC,DIQ,VAFCSEN "RTN","VAFCPDAT",51,0) D PTSEC^DGSEC4(.RESULT,DFN,0,"MPI/PD Patient Inquiry^MPI/PD Patient Inquiry") "RTN","VAFCPDAT",52,0) I RESULT(1)=-1 W !!,"Access denied: Required parameters not defined" G QUIT "RTN","VAFCPDAT",53,0) I RESULT(1)>0 W ?50,"***PATIENT MARKED SENSITIVE***" "RTN","VAFCPDAT",54,0) I RESULT(1)=3 W !!,"Access not allowed on your own PATIENT (#2) file entry" G QUIT "RTN","VAFCPDAT",55,0) I RESULT(1)=4 W !!,"Access denied: Your SSN is not defined" G QUIT "RTN","VAFCPDAT",56,0) I RESULT(1)<3 D "RTN","VAFCPDAT",57,0) . I RESULT(1)=1 D NOTICE^DGSEC4(.VAFCSEN,DFN,"RPC - VAFC REMOTE PDAT FROM THE MPI^MPI/PD Patient Inquiry (Remote)",2) ;IA #3027 "RTN","VAFCPDAT",58,0) . I RESULT(1)=2 D NOTICE^DGSEC4(.VAFCSEN,DFN,"RPC - VAFC REMOTE PDAT FROM THE MPI^MPI/PD Patient Inquiry (Remote)",3) ;IA #3027 "RTN","VAFCPDAT",59,0) W !,"Printed ",HDT," at ",SITENAM,!,LN "RTN","VAFCPDAT",60,0) S $Y=$Y+1 "RTN","VAFCPDAT",61,0) ;next 7 lines modified for **707 "RTN","VAFCPDAT",62,0) W !,"ICN : ",ICN ;CMOR removed **837, MVI_918 "RTN","VAFCPDAT",63,0) W !,"SSN : ",SSN "RTN","VAFCPDAT",64,0) I SSNVER]"" W !?9,"SSN Verification Status: ",SSNVER "RTN","VAFCPDAT",65,0) I SSNVER="",PREAS]"" W !?9,"Pseudo SSN Reason: ",PREAS "RTN","VAFCPDAT",66,0) I SSNVER]"",PREAS]"" W !?9,"Pseudo SSN Reason : ",PREAS "RTN","VAFCPDAT",67,0) W !,"Sex : ",SEX "RTN","VAFCPDAT",68,0) I SIGEN]"" W ?22,"Self Identified Gender: ",SIGEN ;**876 - MVI_3432 (cml) "RTN","VAFCPDAT",69,0) W !,"Claim #: ",CLAIM "RTN","VAFCPDAT",70,0) W !,"Date of Birth: ",DOB "RTN","VAFCPDAT",71,0) I DOD]"" W !,"Date of Death: ",DOD "RTN","VAFCPDAT",72,0) I MBI]"" W !,"Multiple Birth Indicator: ",MBI ;**707 "RTN","VAFCPDAT",73,0) I TIN]"" W !,"DoD Temporary ID Number : ",TIN ;**837, MVI_883 "RTN","VAFCPDAT",74,0) I FIN]"" W !,"DoD Foreign ID Number : ",FIN ;**837, MVI_883 "RTN","VAFCPDAT",75,0) W !,"Address:" I BAI'="" W " (Bad Address Indicator: ",BAI,")" "RTN","VAFCPDAT",76,0) I STR1'="" W !?9,STR1 "RTN","VAFCPDAT",77,0) I STR2'="" W !?9,STR2 "RTN","VAFCPDAT",78,0) I STR3'="" W !?9,STR3 "RTN","VAFCPDAT",79,0) I COUNTRY=""!(CCODE="USA") D ;USA Address **863 - MVI_1902 (ptd) "RTN","VAFCPDAT",80,0) .I CTY]"" W !?9,$E(CTY,1,20)_", "_$G(ST)_" "_$G(ZIP) "RTN","VAFCPDAT",81,0) I COUNTRY]"",CCODE'="USA" D ;Foreign Address "RTN","VAFCPDAT",82,0) .I CTY]""!(PROVINCE]"")!(POSTCODE]"") D "RTN","VAFCPDAT",83,0) ..I PROVINCE]"" W !?9,CTY_", "_PROVINCE_" ("_CNAME_") "_POSTCODE "RTN","VAFCPDAT",84,0) ..I PROVINCE="" W !?9,CTY_", "_"("_CNAME_") "_POSTCODE "RTN","VAFCPDAT",85,0) I PHN'="" W !,"Phone #: ",PHN "RTN","VAFCPDAT",86,0) I $G(IOSL)<30&($E(IOST,1,2)="C-") D "RTN","VAFCPDAT",87,0) .I $Y>23 D "RTN","VAFCPDAT",88,0) ..S DIR(0)="E" D D ^DIR K DIR I 'Y S QFLG=1 "RTN","VAFCPDAT",89,0) ...S SS=22-$Y F JJ=1:1:SS W ! "RTN","VAFCPDAT",90,0) ..S $Y=0 "RTN","VAFCPDAT",91,0) I QFLG=1 G QUIT "RTN","VAFCPDAT",92,0) ; "RTN","VAFCPDAT",93,0) TF ;List Treating Facilities for this patient "RTN","VAFCPDAT",94,0) D TFHDR "RTN","VAFCPDAT",95,0) K TFARR "RTN","VAFCPDAT",96,0) S TF=0 F S TF=$O(^DGCN(391.91,"APAT",DFN,TF)) Q:'TF D "RTN","VAFCPDAT",97,0) .S TFIEN=$O(^DGCN(391.91,"APAT",DFN,TF,0)) "RTN","VAFCPDAT",98,0) . S DIC="^DGCN(391.91,",DR=".02;.03;.07",DA=TFIEN,DIQ(0)="EI",DIQ="TFDATA" "RTN","VAFCPDAT",99,0) . D EN^DIQ1 K DIC,DA,DR,DIQ "RTN","VAFCPDAT",100,0) . S INST="",STATION="" "RTN","VAFCPDAT",101,0) . S INST=$G(TFDATA(391.91,TFIEN,.02,"I")) "RTN","VAFCPDAT",102,0) . I INST'="" D "RTN","VAFCPDAT",103,0) .. S DIC=4,DR="99",DA=INST,DIQ(0)="E",DIQ="STA" "RTN","VAFCPDAT",104,0) .. D EN^DIQ1 K DIC,DA,DR,DIQ "RTN","VAFCPDAT",105,0) .. S STATION=$G(STA(4,INST,99,"E")) "RTN","VAFCPDAT",106,0) . S TFNM=$G(TFDATA(391.91,TFIEN,.02,"E")) "RTN","VAFCPDAT",107,0) . S LSTDT=$G(TFDATA(391.91,TFIEN,.03,"I")) S:LSTDT="" LSTDT="none found" "RTN","VAFCPDAT",108,0) . S LSTSORT=9999999 "RTN","VAFCPDAT",109,0) . I +LSTDT S LSTSORT=9999999-LSTDT,LSTDT=$$FMTE^XLFDT($E(LSTDT,1,12)) "RTN","VAFCPDAT",110,0) . S REACODE=$G(TFDATA(391.91,TFIEN,.07,"E")) S REASON="none found" "RTN","VAFCPDAT",111,0) . I REACODE'="" D "RTN","VAFCPDAT",112,0) .. S DIC="^VAT(391.72,",DIC(0)="Z",X=REACODE D ^DIC K DIC,X "RTN","VAFCPDAT",113,0) .. S REASON=$P($G(Y(0)),"^",4) "RTN","VAFCPDAT",114,0) . S TFARR(LSTSORT,TFNM)=TFIEN_"^"_REASON_"^"_$G(STATION)_"^"_LSTDT "RTN","VAFCPDAT",115,0) I '$D(TFARR) W !,"No Treating Facilities found." G SUB "RTN","VAFCPDAT",116,0) S LSTSORT=0 F S LSTSORT=$O(TFARR(LSTSORT)) Q:'LSTSORT D G:QFLG QUIT "RTN","VAFCPDAT",117,0) .S TFNM="" F S TFNM=$O(TFARR(LSTSORT,TFNM)) Q:TFNM="" D Q:QFLG "RTN","VAFCPDAT",118,0) ..S REASON=$P(TFARR(LSTSORT,TFNM),"^",2) "RTN","VAFCPDAT",119,0) ..S STATION=$P(TFARR(LSTSORT,TFNM),"^",3) "RTN","VAFCPDAT",120,0) ..S LSTDT=$P(TFARR(LSTSORT,TFNM),"^",4) "RTN","VAFCPDAT",121,0) ..I $Y+3>IOSL&($E(IOST,1,2)="C-") D Q:QFLG "RTN","VAFCPDAT",122,0) ...S LNQ=22 D SS Q:QFLG "RTN","VAFCPDAT",123,0) ...W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 D TFHDR "RTN","VAFCPDAT",124,0) ..W !,$E(TFNM,1,20),?22,$G(STATION),?32,LSTDT,?54,REASON "RTN","VAFCPDAT",125,0) SUB ;removed listing of subscribers for RG*1.0*23 "RTN","VAFCPDAT",126,0) HIS ;find ICN history "RTN","VAFCPDAT",127,0) I '$O(^DPT(DFN,"MPIFHIS",0)) G CONT "RTN","VAFCPDAT",128,0) ; "RTN","VAFCPDAT",129,0) I $Y+4>IOSL&($E(IOST,1,2)="C-") D G:QFLG QUIT "RTN","VAFCPDAT",130,0) .S LNQ=22 D SS Q:QFLG "RTN","VAFCPDAT",131,0) .W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 "RTN","VAFCPDAT",132,0) D ICNHDR "RTN","VAFCPDAT",133,0) S HIS=0 F S HIS=$O(^DPT(DFN,"MPIFHIS",HIS)) Q:'HIS D G:QFLG QUIT "RTN","VAFCPDAT",134,0) .S DIC=2,DR="992",DR(2.0992)=".01;1;3",DA=DFN,DA(2.0992)=HIS ;**863 - MVI_2351 (ptd) "RTN","VAFCPDAT",135,0) .S DIQ(0)="E",DIQ="HISNODE" "RTN","VAFCPDAT",136,0) .D EN^DIQ1 K DIC,DA,DR,DIQ "RTN","VAFCPDAT",137,0) .S HISICN=$G(HISNODE(2.0992,HIS,.01,"E")) "RTN","VAFCPDAT",138,0) .S HISCHK=$G(HISNODE(2.0992,HIS,1,"E")) ;**863 - MVI_2351 (ptd) history checksum "RTN","VAFCPDAT",139,0) .S HFULLICN=HISICN_$S(HISCHK]"":"V"_HISCHK,1:"") ;**863 - MVI_2351 (ptd) History full ICN "RTN","VAFCPDAT",140,0) .S HISDT=$G(HISNODE(2.0992,HIS,3,"E")) "RTN","VAFCPDAT",141,0) .I $Y+3>IOSL&($E(IOST,1,2)="C-") D Q:QFLG "RTN","VAFCPDAT",142,0) ..S LNQ=22 D SS Q:QFLG "RTN","VAFCPDAT",143,0) ..W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 D ICNHDR "RTN","VAFCPDAT",144,0) .W !,HFULLICN I HISDT]"" W " - changed ",HISDT ;**863 - MVI_2351 (ptd) "RTN","VAFCPDAT",145,0) ; "RTN","VAFCPDAT",146,0) CONT ;Continue to VAFCPDT2 for extended data "RTN","VAFCPDAT",147,0) ;D CMORHIS^VAFCPDT2 "RTN","VAFCPDAT",148,0) ;CMOR History removed, called changed to EXT^VAFCPDT2 **837, MVI_918 "RTN","VAFCPDAT",149,0) D EXT^VAFCPDT2 "RTN","VAFCPDAT",150,0) DONE ; "RTN","VAFCPDAT",151,0) I QFLG G QUIT "RTN","VAFCPDAT",152,0) I ($E(IOST,1,2)="C-") S LNQ=24 D SS "RTN","VAFCPDAT",153,0) ; "RTN","VAFCPDAT",154,0) QUIT ; "RTN","VAFCPDAT",155,0) K %,CMOR,DIC,DIR,DIRUT,DNODE,GOT,HDT,HFULLICN,HIS,HISCHK,HISDT,HISICN,JJ,LIEN "RTN","VAFCPDAT",156,0) K LINST,LN,LSTDT,MNODE,REACODE,REASON,SCN,SCORE,SITE,SITEIEN,SITENAM,SITENUM "RTN","VAFCPDAT",157,0) K SS,SUBN,SUBARR,TERM,TERMDT,TF,TFARR,TFDATA,TFIEN,TFNM,Y,D,CHG,CHGNODE "RTN","VAFCPDAT",158,0) K HISNODE,DIFF,INST,RGDFN,SCRDT,STATION,STA,LN2,NAME,LSTSORT,LNQ,QFLG,MBI "RTN","VAFCPDAT",159,0) Q "RTN","VAFCPDAT",160,0) TFHDR ; "RTN","VAFCPDAT",161,0) W !!,"Treating Facilities:",?22,"Station:",?32,"DT Last Treated",?54,"Event Reason" "RTN","VAFCPDAT",162,0) W !,"--------------------",?22,"--------",?32,"---------------",?54,"------------" "RTN","VAFCPDAT",163,0) Q "RTN","VAFCPDAT",164,0) ICNHDR W !!,"ICN History:",!,"------------" "RTN","VAFCPDAT",165,0) Q "RTN","VAFCPDAT",166,0) ; "RTN","VAFCPDAT",167,0) SS S DIR(0)="E" D D ^DIR K DIR I 'Y S QFLG=1 "RTN","VAFCPDAT",168,0) .S SS=LNQ-$Y F JJ=1:1:SS W ! "RTN","VAFCPDAT",169,0) Q "RTN","VAFCPDT2") 0^3^B28085527^B26407080 "RTN","VAFCPDT2",1,0) VAFCPDT2 ;BIR/CML/ALS-DISPLAY MPI/PD INFORMATION FOR SELECTED PATIENT ; 1/6/11 3:57pm "RTN","VAFCPDT2",2,0) ;;5.3;Registration;**414,505,627,697,797,876**;Aug 13, 1993;Build 6 "RTN","VAFCPDT2",3,0) ;Reference to ^MPIF(984.9,"C" supported by IA #3298 "RTN","VAFCPDT2",4,0) ; "RTN","VAFCPDT2",5,0) CMORHIS ;Find CMOR History "RTN","VAFCPDT2",6,0) I '$O(^DPT(DFN,"MPICMOR",0)) G CMORCHG "RTN","VAFCPDT2",7,0) I $Y+4>IOSL&($E(IOST,1,2)="C-") D Q:QFLG "RTN","VAFCPDT2",8,0) .S LNQ=22 D SS^VAFCPDAT Q:QFLG "RTN","VAFCPDT2",9,0) .W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 "RTN","VAFCPDT2",10,0) D CHISHDR "RTN","VAFCPDT2",11,0) S HIS=0 F S HIS=$O(^DPT(DFN,"MPICMOR",HIS)) Q:'HIS D Q:QFLG "RTN","VAFCPDT2",12,0) .S DIC=2,DR="993",DR(2.0993)=".01;3",DA=DFN,DA(2.0993)=HIS "RTN","VAFCPDT2",13,0) .S DIQ(0)="E",DIQ="CMORNODE" "RTN","VAFCPDT2",14,0) .D EN^DIQ1 K DIC,DR,DA,DIQ "RTN","VAFCPDT2",15,0) .S HISCMOR=$G(CMORNODE(2.0993,HIS,.01,"E")) "RTN","VAFCPDT2",16,0) .I +HISCMOR S HISCMOR=$$GET1^DIQ(4,HISCMOR,.01) "RTN","VAFCPDT2",17,0) .S CHGDT=$G(CMORNODE(2.0993,HIS,3,"E")) "RTN","VAFCPDT2",18,0) .I $Y+3>IOSL&($E(IOST,1,2)="C-") D Q:QFLG "RTN","VAFCPDT2",19,0) ..S LNQ=22 D SS^VAFCPDAT Q:QFLG "RTN","VAFCPDT2",20,0) ..W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 D CHISHDR "RTN","VAFCPDT2",21,0) .W !,$P(CHGDT,"@"),?12," - CMOR changed from ",HISCMOR "RTN","VAFCPDT2",22,0) ; "RTN","VAFCPDT2",23,0) CMORCHG ;Find CMOR change request "RTN","VAFCPDT2",24,0) I '$O(^MPIF(984.9,"C",DFN,0)) G EXT "RTN","VAFCPDT2",25,0) I $Y+4>IOSL&($E(IOST,1,2)="C-") D Q:QFLG "RTN","VAFCPDT2",26,0) .S LNQ=22 D SS^VAFCPDAT Q:QFLG "RTN","VAFCPDT2",27,0) .W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 "RTN","VAFCPDT2",28,0) D CCHGHDR "RTN","VAFCPDT2",29,0) S CHG=0 F S CHG=$O(^MPIF(984.9,"C",DFN,CHG)) Q:'CHG D Q:QFLG "RTN","VAFCPDT2",30,0) .S DIC=984.9,DA=CHG,DR=".01;.03;.06;.07;.08;1.03",DIQ="CHGNODE" "RTN","VAFCPDT2",31,0) .S DIQ(0)="EI" D EN^DIQ1 K DIC,DA,DR,DIQ "RTN","VAFCPDT2",32,0) .S CHGNUM=$G(CHGNODE(984.9,CHG,.01,"E")) "RTN","VAFCPDT2",33,0) .S CHGDT=$G(CHGNODE(984.9,CHG,.03,"E")) "RTN","VAFCPDT2",34,0) .S TMSG=$G(CHGNODE(984.9,CHG,.08,"E")) "RTN","VAFCPDT2",35,0) .S TREQ=$G(CHGNODE(984.9,CHG,1.03,"E")) "RTN","VAFCPDT2",36,0) .S SITE=$G(CHGNODE(984.9,CHG,.07,"E")) "RTN","VAFCPDT2",37,0) .S STATUS=$G(CHGNODE(984.9,CHG,.06,"E")) "RTN","VAFCPDT2",38,0) .I $Y+4>IOSL&($E(IOST,1,2)="C-") D Q:QFLG "RTN","VAFCPDT2",39,0) ..S LNQ=22 D SS^VAFCPDAT Q:QFLG "RTN","VAFCPDT2",40,0) ..W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 D CCHGHDR "RTN","VAFCPDT2",41,0) .W !,"REQUEST #",CHGNUM," - ",TMSG," ",CHGDT "RTN","VAFCPDT2",42,0) .W !?4,"Type of Request: ",TREQ," ",SITE "RTN","VAFCPDT2",43,0) .W !?4,"Status : ",STATUS,! "RTN","VAFCPDT2",44,0) ; "RTN","VAFCPDT2",45,0) EXT ;Extended patient demographic data "RTN","VAFCPDT2",46,0) I $E(IOST,1,2)="C-" D Q:QFLG "RTN","VAFCPDT2",47,0) .S LNQ=22 D SS^VAFCPDAT Q:QFLG "RTN","VAFCPDT2",48,0) .W @IOF "RTN","VAFCPDT2",49,0) I QFLG=1 G QUIT^VAFCPDAT "RTN","VAFCPDT2",50,0) W !!,"Additional DPT Data for: ",NAME," (DFN #",DFN,")",!,LN2 "RTN","VAFCPDT2",51,0) S DA=DFN,DIC=2,DIQ="XDATA",DIQ(0)="EI" "RTN","VAFCPDT2",52,0) S DR=".05;.08;.092;.093;.219;.2401;.2402;.2403;.211;.302;.323;.341;.331;.361;1901;.325;.328;.326;.327;.097;.525;391" ;**876 - MVI_3432 (cml) "RTN","VAFCPDT2",53,0) N COB,SOB,FNM,MNM,MMNM,NOK,NOKN,DESIG,EMER,ELIG,VET,SRVBR,SRVNUM,SRVEDT,SRVSDT,SRVCPCT,POSRVC,FILEDT,MARS,RELP,POW,NODE,MSD,PATTYPE ;**876 - MVI_3432 (cml) "RTN","VAFCPDT2",54,0) D EN^DIQ1 K DIC,DA,DR,DIQ "RTN","VAFCPDT2",55,0) S COB=$G(XDATA(2,DFN,.092,"E")),SOB=$G(XDATA(2,DFN,.093,"E")) "RTN","VAFCPDT2",56,0) S FILEDT=$G(XDATA(2,DFN,.097,"E")),FNM=$G(XDATA(2,DFN,.2401,"E")) "RTN","VAFCPDT2",57,0) S MNM=$G(XDATA(2,DFN,.2402,"E")),MMNM=$G(XDATA(2,DFN,.2403,"E")) "RTN","VAFCPDT2",58,0) S NOK=$G(XDATA(2,DFN,.211,"E")),DESIG=$G(XDATA(2,DFN,.341,"E")) "RTN","VAFCPDT2",59,0) S EMER=$G(XDATA(2,DFN,.331,"E")) "RTN","VAFCPDT2",60,0) S ELIG=$G(XDATA(2,DFN,.361,"E")),VET=$G(XDATA(2,DFN,1901,"E")) "RTN","VAFCPDT2",61,0) S SRVBR=$G(XDATA(2,DFN,.325,"E")),SRVNUM=$G(XDATA(2,DFN,.328,"E")) "RTN","VAFCPDT2",62,0) S SRVEDT=$G(XDATA(2,DFN,.326,"E")),SRVSDT=$G(XDATA(2,DFN,.327,"E")) "RTN","VAFCPDT2",63,0) S MARS=$G(XDATA(2,DFN,.05,"E")),RELP=$G(XDATA(2,DFN,.08,"E")) "RTN","VAFCPDT2",64,0) S POSRVC=$G(XDATA(2,DFN,.323,"E")),SRVCPCT=$G(XDATA(2,DFN,.302,"E")) "RTN","VAFCPDT2",65,0) S NOKN=$G(XDATA(2,DFN,.219,"E")),POW=$G(XDATA(2,DFN,.525,"E")) "RTN","VAFCPDT2",66,0) S PATTYPE=$G(XDATA(2,DFN,391,"E")) ;**876 - MVI_3432 (cml) "RTN","VAFCPDT2",67,0) ; "RTN","VAFCPDT2",68,0) W !,"PLACE OF BIRTH [CITY]",?31,": ",COB "RTN","VAFCPDT2",69,0) W !,"PLACE OF BIRTH [STATE]",?31,": ",SOB "RTN","VAFCPDT2",70,0) W !,"FATHER'S NAME",?31,": ",FNM "RTN","VAFCPDT2",71,0) W !,"MOTHER'S NAME",?31,": ",MNM "RTN","VAFCPDT2",72,0) W !,"MOTHER'S MAIDEN NAME",?31,": ",MMNM "RTN","VAFCPDT2",73,0) W !,"NAME OF PRIMARY NEXT OF KIN",?31,": ",NOK "RTN","VAFCPDT2",74,0) W !,"NEXT OF KIN PHONE NUMBER",?31,": ",NOKN "RTN","VAFCPDT2",75,0) W !,"NAME OF DESIGNEE",?31,": ",DESIG "RTN","VAFCPDT2",76,0) W !,"EMERGENCY NAME",?31,": ",EMER "RTN","VAFCPDT2",77,0) W !,"MARITAL STATUS",?31,": ",MARS "RTN","VAFCPDT2",78,0) W !,"RELIGIOUS PREFERENCE",?31,": ",RELP "RTN","VAFCPDT2",79,0) ; "RTN","VAFCPDT2",80,0) D DEM^VADPT "RTN","VAFCPDT2",81,0) ;ETHNICITY info "RTN","VAFCPDT2",82,0) I $G(VADM(11,1)) W !,"ETHNICITY INFORMATION",?31,": ",$P(VADM(11,1),"^",2) "RTN","VAFCPDT2",83,0) ; "RTN","VAFCPDT2",84,0) ;RACE multiple "RTN","VAFCPDT2",85,0) I $O(VADM(12,0)) D "RTN","VAFCPDT2",86,0) .W !,"RACE INFORMATION (multiple):" "RTN","VAFCPDT2",87,0) .S RACEMUL=0 F S RACEMUL=$O(VADM(12,RACEMUL)) Q:'RACEMUL W !?3,$P(VADM(12,RACEMUL),"^",2) "RTN","VAFCPDT2",88,0) ; "RTN","VAFCPDT2",89,0) W !,"PRIMARY ELIGIBILITY CODE",?31,": ",ELIG "RTN","VAFCPDT2",90,0) W !,"PATIENT TYPE",?31,": ",PATTYPE ;**876 - MVI_3432 (cml) "RTN","VAFCPDT2",91,0) W !,"VETERAN (Y/N)?",?31,": ",VET "RTN","VAFCPDT2",92,0) W !,"SERVICE CONNECTED PERCENT",?31,": ",SRVCPCT "RTN","VAFCPDT2",93,0) W !,"PERIOD OF SERVICE",?31,": ",POSRVC "RTN","VAFCPDT2",94,0) W !,"POW STATUS INDICATED?",?31,": ",POW "RTN","VAFCPDT2",95,0) ; "RTN","VAFCPDT2",96,0) ;Military Service Data multiple "RTN","VAFCPDT2",97,0) I $O(^DPT(DFN,.3216,0)) D "RTN","VAFCPDT2",98,0) .W !,"MILITARY SERVICE (multiple):" "RTN","VAFCPDT2",99,0) .W !,"Service Branch Service # Entry DT Separation DT" "RTN","VAFCPDT2",100,0) .W !,"---------------------------------------------------------" "RTN","VAFCPDT2",101,0) .K MSDARR "RTN","VAFCPDT2",102,0) .S MSD=0 F S MSD=$O(^DPT(DFN,.3216,MSD)) Q:'MSD D "RTN","VAFCPDT2",103,0) ..S NODE=^DPT(DFN,.3216,MSD,0) "RTN","VAFCPDT2",104,0) ..S SRVEDT=$P(NODE,"^"),SRVSDT=$P(NODE,"^",2),SRVNUM=$P(NODE,"^",5),SRVBR=$$GET1^DIQ(23,$P(NODE,"^",3),.01) "RTN","VAFCPDT2",105,0) ..S MSDARR(-SRVEDT)=SRVSDT_"^"_SRVNUM_"^"_SRVBR "RTN","VAFCPDT2",106,0) .S SRVEDT="" F S SRVEDT=$O(MSDARR(SRVEDT)) Q:'SRVEDT D "RTN","VAFCPDT2",107,0) ..W !?0,$P(MSDARR(SRVEDT),"^",3),?17,$P(MSDARR(SRVEDT),"^",2),?29,$$FMTE^XLFDT($P(SRVEDT,"-",2)),?44,$$FMTE^XLFDT(+MSDARR(SRVEDT)) "RTN","VAFCPDT2",108,0) ; "RTN","VAFCPDT2",109,0) ;ALIAS multiple "RTN","VAFCPDT2",110,0) I $O(^DPT(DFN,.01,0)) D "RTN","VAFCPDT2",111,0) .W !,"ALIAS (multiple):" "RTN","VAFCPDT2",112,0) .S ALIAS=0 F S ALIAS=$O(^DPT(DFN,.01,ALIAS)) Q:'ALIAS W !?3,$E($P(^DPT(DFN,.01,ALIAS,0),"^"),1,30),?35,"SSN: "_$P($G(^DPT(DFN,.01,ALIAS,0)),"^",2) "RTN","VAFCPDT2",113,0) ; "RTN","VAFCPDT2",114,0) W !,"DATE ENTERED IN PATIENT FILE",?31,": ",FILEDT "RTN","VAFCPDT2",115,0) ; "RTN","VAFCPDT2",116,0) K ALIAS,XDATA,CHG,CHGNUM,CHGDT,TMSG,TREQ,SITE,STATUS,HIS,HISCMOR,CMORNODE,CHGNODE,RACEMUL,VADM,MSDARR "RTN","VAFCPDT2",117,0) Q "RTN","VAFCPDT2",118,0) ; "RTN","VAFCPDT2",119,0) CHISHDR W !!,"CMOR History:",!,"--------------" "RTN","VAFCPDT2",120,0) Q "RTN","VAFCPDT2",121,0) CCHGHDR W !!,"CMOR Change Request History:",!,"----------------------------" "RTN","VAFCPDT2",122,0) Q "RTN","VAFCPTAD") 0^6^B69026178^B64926627 "RTN","VAFCPTAD",1,0) VAFCPTAD ; ISA/RJS,Zoltan;BIR/PTD,CKN - ADD NEW PATIENT ENTRY ; 8/14/14 6:07pm "RTN","VAFCPTAD",2,0) ;;5.3;Registration;**149,800,876**;Aug 13, 1993;Build 6 "RTN","VAFCPTAD",3,0) ; "RTN","VAFCPTAD",4,0) ADD(RETURN,PARAM) ;Add an entry to the PATIENT (#2) file for VOA "RTN","VAFCPTAD",5,0) ; "RTN","VAFCPTAD",6,0) ;Input "RTN","VAFCPTAD",7,0) ; PARAM = List of data to be used for the creation of a VistA "RTN","VAFCPTAD",8,0) ; PATIENT (#2) record at the Preferred Facility. "RTN","VAFCPTAD",9,0) ; "RTN","VAFCPTAD",10,0) ;Required elements include: "RTN","VAFCPTAD",11,0) ; PARAM("PRFCLTY")=PREFERRED FACILITY "RTN","VAFCPTAD",12,0) ; PARAM("NAME")=NAME (last name minimal; recommend full name) "RTN","VAFCPTAD",13,0) ; PARAM("GENDER")=SEX "RTN","VAFCPTAD",14,0) ; PARAM("DOB")=DATE OF BIRTH "RTN","VAFCPTAD",15,0) ; PARAM("SSN")=SOCIAL SECURITY NUMBER OR NULL IF NONE "RTN","VAFCPTAD",16,0) ; PARAM("SRVCNCTD")=SERVICE CONNECTED? "RTN","VAFCPTAD",17,0) ; PARAM("TYPE")=TYPE "RTN","VAFCPTAD",18,0) ; PARAM("VET")=VETERAN (Y/N)? "RTN","VAFCPTAD",19,0) ; PARAM("FULLICN")=INTEGRATION CONTROL NUMBER AND CHECKSUM "RTN","VAFCPTAD",20,0) ; "RTN","VAFCPTAD",21,0) ;Optional elements include: "RTN","VAFCPTAD",22,0) ; PARAM("POBCTY")=PLACE OF BIRTH [CITY] "RTN","VAFCPTAD",23,0) ; PARAM("POBST")=PLACE OF BIRTH [STATE] "RTN","VAFCPTAD",24,0) ; PARAM("MMN")=MOTHER'S MAIDEN NAME "RTN","VAFCPTAD",25,0) ; PARAM("MBI")=MULTIPLE BIRTH INDICATOR "RTN","VAFCPTAD",26,0) ; PARAM("ALIAS",#)=ALIAS NAME(last^first^middle^suffix)^ALIAS SSN "RTN","VAFCPTAD",27,0) ; "RTN","VAFCPTAD",28,0) ;Output: "RTN","VAFCPTAD",29,0) ; On Failure: -1^error text - record add failed "RTN","VAFCPTAD",30,0) ; On Success: 1^DFN of new PATIENT (#2) record "RTN","VAFCPTAD",31,0) ; "RTN","VAFCPTAD",32,0) EN1 ;Check value of all required fields "RTN","VAFCPTAD",33,0) N ALSERR,DIERR,DPTIDS,DPTX,ERROR,FLG,FDA,FN,LN,MN,RESULT,RGRSICN,SFX,VAL,VAFCA08,X,Y "RTN","VAFCPTAD",34,0) N VAFCDFN,VAFCDOB,VAFCICN,VAFCMMN,VAFCNAM,VAFCPF,VAFCPOBC,VAFCPOBS "RTN","VAFCPTAD",35,0) N VAFCRSN,VAFCSRV,VAFCSSN,VAFCSUM,VAFCSX,VAFCTYP,VAFCVET,VAFCMBI "RTN","VAFCPTAD",36,0) K RETURN "RTN","VAFCPTAD",37,0) S (RGRSICN,VAFCA08)=1 S FLG=0 ;allow update to ICN; prevent triggering of messages "RTN","VAFCPTAD",38,0) ; "RTN","VAFCPTAD",39,0) ;PREFERRED FACILITY "RTN","VAFCPTAD",40,0) I $G(PARAM("PRFCLTY"))="" S RETURN(1)="-1^PREFERRED FACILITY is a required field." Q "RTN","VAFCPTAD",41,0) I $G(PARAM("PRFCLTY"))'=$P($$SITE^VASITE(),"^",3) S RETURN(1)="-1^PREFERRED FACILITY is not the station to which the RPC was sent." Q "RTN","VAFCPTAD",42,0) I $G(PARAM("PRFCLTY"))'="" S VAL=$G(PARAM("PRFCLTY")) D CHK^DIE(2,27.02,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q "RTN","VAFCPTAD",43,0) S VAFCPF=VAL,FLG=1 "RTN","VAFCPTAD",44,0) ; "RTN","VAFCPTAD",45,0) ;INTEGRATION CONTROL NUMBER and ICN CHECKSUM "RTN","VAFCPTAD",46,0) I $G(PARAM("FULLICN"))="" S RETURN(1)="-1^Full INTEGRATION CONTROL NUMBER with ICN CHECKSUM is required." Q "RTN","VAFCPTAD",47,0) I $G(PARAM("FULLICN"))'["V" S RETURN(1)="-1^Full INTEGRATION CONTROL NUMBER with ICN CHECKSUM is required." Q "RTN","VAFCPTAD",48,0) I $G(PARAM("FULLICN"))'="" D "RTN","VAFCPTAD",49,0) .S PARAM("ICN")=$P(PARAM("FULLICN"),"V") "RTN","VAFCPTAD",50,0) .S PARAM("CHKSUM")=$P(PARAM("FULLICN"),"V",2) "RTN","VAFCPTAD",51,0) I $G(PARAM("ICN"))'="" S VAL=$G(PARAM("ICN")) D CHK^DIE(2,991.01,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q "RTN","VAFCPTAD",52,0) S VAFCICN=VAL,FLG=1 "RTN","VAFCPTAD",53,0) I $G(PARAM("CHKSUM"))'="" S VAL=$G(PARAM("CHKSUM")) D CHK^DIE(2,991.02,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q "RTN","VAFCPTAD",54,0) S VAFCSUM=VAL,FLG=1 "RTN","VAFCPTAD",55,0) ;Has patient already been created at this facility? If so get DFN and quit. "RTN","VAFCPTAD",56,0) I $O(^DPT("AICN",PARAM("ICN"),0)) S RETURN(1)="1^"_$O(^DPT("AICN",PARAM("ICN"),0)) Q "RTN","VAFCPTAD",57,0) ; "RTN","VAFCPTAD",58,0) ;NAME INPUT AS:LAST^FIRST^MIDDLE^SUFFIX; MUST BE FORMATTED FOR VISTA INPUT "RTN","VAFCPTAD",59,0) I $G(PARAM("NAME"))="" S RETURN(1)="-1^Patient NAME is a required field." Q "RTN","VAFCPTAD",60,0) S LN=$P($G(PARAM("NAME")),"^"),FN=$P($G(PARAM("NAME")),"^",2),MN=$P($G(PARAM("NAME")),"^",3),SFX=$P($G(PARAM("NAME")),"^",4) "RTN","VAFCPTAD",61,0) S PARAM("NAME")=LN_"," "RTN","VAFCPTAD",62,0) I FN'="" S PARAM("NAME")=PARAM("NAME")_FN "RTN","VAFCPTAD",63,0) I MN'="" S PARAM("NAME")=PARAM("NAME")_" "_MN "RTN","VAFCPTAD",64,0) I SFX'="" S PARAM("NAME")=PARAM("NAME")_" "_SFX "RTN","VAFCPTAD",65,0) I $G(PARAM("NAME"))'="" S VAL=$G(PARAM("NAME")) D CHK^DIE(2,.01,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q "RTN","VAFCPTAD",66,0) S VAFCNAM=VAL,FLG=1 "RTN","VAFCPTAD",67,0) S DPTX=VAL ;variable used by SSN input transform "RTN","VAFCPTAD",68,0) ; "RTN","VAFCPTAD",69,0) ;DATE OF BIRTH "RTN","VAFCPTAD",70,0) I $G(PARAM("DOB"))="" S RETURN(1)="-1^DATE OF BIRTH is a required field." Q "RTN","VAFCPTAD",71,0) I $G(PARAM("DOB"))'="" S VAL=$G(PARAM("DOB")) D CHK^DIE(2,.03,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q "RTN","VAFCPTAD",72,0) S VAFCDOB=VAL,FLG=1 "RTN","VAFCPTAD",73,0) S DPTIDS(.03)=RESULT ;variable used by PSEUDO-SSN code "RTN","VAFCPTAD",74,0) ; "RTN","VAFCPTAD",75,0) ;SOCIAL SECURITY NUMBER not equal null; valid 9-digit number "RTN","VAFCPTAD",76,0) I '$D(PARAM("SSN")) S RETURN(1)="-1^SOCIAL SECURITY NUMBER is a required field. A null value may be sent." Q "RTN","VAFCPTAD",77,0) I $G(PARAM("SSN"))'="" S VAL=$G(PARAM("SSN")) D CHK^DIE(2,.09,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q "RTN","VAFCPTAD",78,0) I $G(PARAM("SSN"))'="" S VAFCSSN=VAL,FLG=1 "RTN","VAFCPTAD",79,0) I $G(PARAM("SSN"))="" D ;SSN null, set PSEUDO SSN REASON=SSN UNKNOWN/FOLLOW-UP "RTN","VAFCPTAD",80,0) .S PARAM("SSN")="P" ;PSEUDO SSN "RTN","VAFCPTAD",81,0) .S PARAM("PSEUDO")="S" ;PSEUDO SSN REASON "RTN","VAFCPTAD",82,0) .S VAFCSSN=$G(PARAM("SSN")),FLG=1 "RTN","VAFCPTAD",83,0) .;If SSN null, set PSEUDO SSN REASON (#.0906) =SSN UNKNOWN/FOLLOW-UP "RTN","VAFCPTAD",84,0) .S VAFCRSN=$G(PARAM("PSEUDO")),FLG=1 "RTN","VAFCPTAD",85,0) ; "RTN","VAFCPTAD",86,0) ;SEX "RTN","VAFCPTAD",87,0) I $G(PARAM("GENDER"))="" S RETURN(1)="-1^GENDER is a required field." Q "RTN","VAFCPTAD",88,0) I $G(PARAM("GENDER"))'="" S VAL=$G(PARAM("GENDER")) D CHK^DIE(2,.02,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q "RTN","VAFCPTAD",89,0) S VAFCSX=VAL,FLG=1 "RTN","VAFCPTAD",90,0) ; "RTN","VAFCPTAD",91,0) ;SERVICE CONNECTED? "RTN","VAFCPTAD",92,0) I $G(PARAM("SRVCNCTD"))="" S RETURN(1)="-1^'SERVICE CONNECTED?' is a required field." Q "RTN","VAFCPTAD",93,0) ;input set to either YES or NO on the MPI before RPC call; skip CHK^DIE "RTN","VAFCPTAD",94,0) ;here as it resulted in error; expected DFN variable which is not yet set. "RTN","VAFCPTAD",95,0) I $G(PARAM("SRVCNCTD"))'="" S VAFCSRV=$G(PARAM("SRVCNCTD")) "RTN","VAFCPTAD",96,0) ; "RTN","VAFCPTAD",97,0) ;TYPE "RTN","VAFCPTAD",98,0) I $G(PARAM("TYPE"))="" S RETURN(1)="-1^Patient TYPE is a required field." Q "RTN","VAFCPTAD",99,0) I $G(PARAM("TYPE"))'="" S VAL=$G(PARAM("TYPE")) D CHK^DIE(2,391,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q "RTN","VAFCPTAD",100,0) S VAFCTYP=VAL,FLG=1 "RTN","VAFCPTAD",101,0) ; "RTN","VAFCPTAD",102,0) ;VETERAN Y/N? "RTN","VAFCPTAD",103,0) I $G(PARAM("VET"))="" S RETURN(1)="-1^'VETERAN Y/N?' is a required field." Q "RTN","VAFCPTAD",104,0) ;input set to either YES or NO on the MPI before RPC call; skip CHK^DIE "RTN","VAFCPTAD",105,0) ;here as it resulted in error; expected DFN variable which is not yet set. "RTN","VAFCPTAD",106,0) I $G(PARAM("VET"))'="" S VAFCVET=$E($G(PARAM("VET")),1),FLG=1 ;internal format "RTN","VAFCPTAD",107,0) ; "RTN","VAFCPTAD",108,0) ;Optional - POB CITY "RTN","VAFCPTAD",109,0) I $D(PARAM("POBCTY")) S VAL=$G(PARAM("POBCTY")) D CHK^DIE(2,.092,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q "RTN","VAFCPTAD",110,0) I $D(PARAM("POBCTY")) S VAFCPOBC=VAL,FLG=1 "RTN","VAFCPTAD",111,0) ; "RTN","VAFCPTAD",112,0) ;Optional - POB STATE "RTN","VAFCPTAD",113,0) N STIEN,UNDEF S UNDEF=0 "RTN","VAFCPTAD",114,0) I $D(PARAM("POBST")) D I UNDEF S RETURN(1)="-1^The value passed for PLACE OF BIRTH [STATE], "_PARAM("POBST")_", is not a valid STATE (#5) file entry." Q "RTN","VAFCPTAD",115,0) .;Convert STATE ABBREVIATION into STATE NAME "RTN","VAFCPTAD",116,0) .S STIEN=$O(^DIC(5,"C",PARAM("POBST"),0)) "RTN","VAFCPTAD",117,0) .I STIEN="" S UNDEF=1 Q "RTN","VAFCPTAD",118,0) .I STIEN'="" S PARAM("POBST")=$P($G(^DIC(5,STIEN,0)),"^") "RTN","VAFCPTAD",119,0) .S VAL=$G(PARAM("POBST")) "RTN","VAFCPTAD",120,0) .D CHK^DIE(2,.093,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q "RTN","VAFCPTAD",121,0) .S VAFCPOBS=VAL,FLG=1 "RTN","VAFCPTAD",122,0) ; "RTN","VAFCPTAD",123,0) ;Optional - MOTHER'S MAIDEN NAME "RTN","VAFCPTAD",124,0) I $D(PARAM("MMN")) S VAL=$G(PARAM("MMN")) D CHK^DIE(2,.2403,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q "RTN","VAFCPTAD",125,0) I $D(PARAM("MMN")) S VAFCMMN=VAL,FLG=1 "RTN","VAFCPTAD",126,0) ; "RTN","VAFCPTAD",127,0) ;**876 - MVI_2788 (ckn) - Add MBI "RTN","VAFCPTAD",128,0) ;Optional - MULTIPLE BIRTH INDICATOR "RTN","VAFCPTAD",129,0) I $D(PARAM("MBI")) S VAL=$G(PARAM("MBI")) D CHK^DIE(2,994,,VAL,.RESULT) I RESULT="^" S RETURN(1)="-1^"_^TMP("DIERR",$J,1,"TEXT",1) Q "RTN","VAFCPTAD",130,0) I $G(PARAM("MBI"))'="" S VAFCMBI=VAL,FLG=1 "RTN","VAFCPTAD",131,0) ; "RTN","VAFCPTAD",132,0) I FLG=0 S RETURN(1)="-1^Required information is missing; please check input and try again." Q "RTN","VAFCPTAD",133,0) ;Else ok to file entry "RTN","VAFCPTAD",134,0) FILE ;Call FILE^DICN to add new entry to PATIENT (#2) file "RTN","VAFCPTAD",135,0) N DA,DIC,DR K DD,DO "RTN","VAFCPTAD",136,0) S DIC="^DPT(",DIC(0)="FLZ",DLAYGO=2,X=VAFCNAM "RTN","VAFCPTAD",137,0) ;**876 MVI_2788 (ckn) - Remove four slash use for field 1901 "RTN","VAFCPTAD",138,0) S DIC("DR")=".09///"_VAFCSSN_";.03///"_VAFCDOB_";.02///"_VAFCSX_";391///"_VAFCTYP_";1901///"_VAFCVET_";.301///"_VAFCSRV_";991.01///"_VAFCICN_";991.02///"_VAFCSUM_";27.02///"_VAFCPF "RTN","VAFCPTAD",139,0) I VAFCSSN="P" S DIC("DR")=DIC("DR")_";.0906///"_VAFCRSN "RTN","VAFCPTAD",140,0) I $G(VAFCPOBC)'="" S DIC("DR")=DIC("DR")_";.092///"_VAFCPOBC "RTN","VAFCPTAD",141,0) I $G(VAFCPOBS)'="" S DIC("DR")=DIC("DR")_";.093///"_VAFCPOBS "RTN","VAFCPTAD",142,0) I $G(VAFCMMN)'="" S DIC("DR")=DIC("DR")_";.2403///"_VAFCMMN "RTN","VAFCPTAD",143,0) ;**876 - MVI_2788 (ckn) "RTN","VAFCPTAD",144,0) I $G(VAFCMBI)'="" S DIC("DR")=DIC("DR")_";994///"_VAFCMBI "RTN","VAFCPTAD",145,0) L +^DPT(0):10 "RTN","VAFCPTAD",146,0) D FILE^DICN K DA,DIC,DD,DLAYGO,DO,DR "RTN","VAFCPTAD",147,0) L -^DPT(0) "RTN","VAFCPTAD",148,0) ;If record creation/update fails, return a -1^error text "RTN","VAFCPTAD",149,0) I $P(Y,U,3)'=1 S RETURN(1)="-1^"_"Attempt to add patient "_VAFCNAM_" to the PATIENT (#2) file at station number "_$P($$SITE^VASITE,"^",3)_" failed." Q "RTN","VAFCPTAD",150,0) S VAFCDFN=+Y "RTN","VAFCPTAD",151,0) ; "RTN","VAFCPTAD",152,0) ;File ALIAS multiple "RTN","VAFCPTAD",153,0) I $D(PARAM("ALIAS")) D ALIAS ;If ALIAS data is passed, call ALIAS module "RTN","VAFCPTAD",154,0) I $G(ALSERR)="" S RETURN(1)="1^"_VAFCDFN ;No errors for ALIAS, return DFN "RTN","VAFCPTAD",155,0) I $G(ALSERR)'="" S RETURN(1)=ALSERR "RTN","VAFCPTAD",156,0) Q "RTN","VAFCPTAD",157,0) ; "RTN","VAFCPTAD",158,0) ; "RTN","VAFCPTAD",159,0) ALIAS ;Optional - Add ALIAS and ALIAS SSN data for entry "RTN","VAFCPTAD",160,0) ;Only occurs for a NEW record; there is no previous ALIAS data "RTN","VAFCPTAD",161,0) I '$D(PARAM("ALIAS")) Q "RTN","VAFCPTAD",162,0) ;ALIAS input comes in as: LAST^FIRST^MIDDLE^SUFFIX^SSN "RTN","VAFCPTAD",163,0) N AFN,ALN,AMN,ASFX,ASSN,ERR,FDA,I,LOC,NUM "RTN","VAFCPTAD",164,0) S (I,NUM)=0 F S NUM=$O(PARAM("ALIAS",NUM)) Q:'NUM D "RTN","VAFCPTAD",165,0) .S ALN=$P($G(PARAM("ALIAS",NUM)),"^") Q:ALN="" ;Last name minimal input "RTN","VAFCPTAD",166,0) .S AFN=$P($G(PARAM("ALIAS",NUM)),"^",2) "RTN","VAFCPTAD",167,0) .S AMN=$P($G(PARAM("ALIAS",NUM)),"^",3) "RTN","VAFCPTAD",168,0) .S ASFX=$P($G(PARAM("ALIAS",NUM)),"^",4) "RTN","VAFCPTAD",169,0) .S ASSN=$P($G(PARAM("ALIAS",NUM)),"^",5) "RTN","VAFCPTAD",170,0) .;Change format for VistA input: LAST,FIRST MIDDLE SUFFIX^SSN "RTN","VAFCPTAD",171,0) .S LOC(NUM)=ALN_"," "RTN","VAFCPTAD",172,0) .I AFN'="" S LOC(NUM)=LOC(NUM)_AFN "RTN","VAFCPTAD",173,0) .I AMN'="" S LOC(NUM)=LOC(NUM)_" "_AMN "RTN","VAFCPTAD",174,0) .I ASFX'="" S LOC(NUM)=LOC(NUM)_" "_ASFX "RTN","VAFCPTAD",175,0) .S LOC(NUM)=LOC(NUM)_"^" "RTN","VAFCPTAD",176,0) .I ASSN'="" S LOC(NUM)=LOC(NUM)_ASSN "RTN","VAFCPTAD",177,0) .;Set FDA nodes "RTN","VAFCPTAD",178,0) .S I=I+1 ;Unique sequence number for add to ALIAS SUB-FILE (#2.01 "RTN","VAFCPTAD",179,0) .S FDA(2.01,"+"_I_","_VAFCDFN_",",.01)=$P(LOC(NUM),"^") ; (#.01) ALIAS (name) "RTN","VAFCPTAD",180,0) .I ASSN'="" S FDA(2.01,"+"_I_","_VAFCDFN_",",1)=$P(LOC(NUM),"^",2) ; (#1) ALIAS SSN "RTN","VAFCPTAD",181,0) ;Update ALIAS multiple with new entries "RTN","VAFCPTAD",182,0) I $D(FDA) D ;We have ALIAS data to add "RTN","VAFCPTAD",183,0) .S ALSERR="" "RTN","VAFCPTAD",184,0) .L +^DPT(VAFCDFN):10 "RTN","VAFCPTAD",185,0) .D UPDATE^DIE("E","FDA",,"ERR") "RTN","VAFCPTAD",186,0) .L -^DPT(VAFCDFN) "RTN","VAFCPTAD",187,0) .I $D(ERR("DIERR")) S ALSERR="1^"_VAFCDFN_"^Patient "_PARAM("NAME")_" was successfully added at "_$P($$SITE^VASITE,"^",3)_". However, the ALIAS data failed to update. Error message: "_$G(ERR("DIERR","1","TEXT",1)) Q "RTN","VAFCPTAD",188,0) Q "RTN","VAFCPTAD",189,0) ; "RTN","VAFCQRY2") 0^8^B18522846^B18262302 "RTN","VAFCQRY2",1,0) VAFCQRY2 ;BIR/DLR-Query for patient demographics ; 8/12/14 1:24pm "RTN","VAFCQRY2",2,0) ;;5.3;Registration;**428,876**;Aug 13, 1993;Build 6 "RTN","VAFCQRY2",3,0) ; "RTN","VAFCQRY2",4,0) ;Reference to $$GETDFNS^MPIF002 supported by IA #3634. "RTN","VAFCQRY2",5,0) ; "RTN","VAFCQRY2",6,0) CHKID(ICN,SSN,DFN) ; "RTN","VAFCQRY2",7,0) N EVN,PID,PD1,EVN,LTD,VAFCMN,VAFCER "RTN","VAFCQRY2",8,0) ;find the patient "RTN","VAFCQRY2",9,0) N LDFN,SITE,RDFN "RTN","VAFCQRY2",10,0) ;if DFN is not passed check ICN "RTN","VAFCQRY2",11,0) I $G(DFN)="" S DFN=$$GETDFN^MPIF001(+ICN) D Q "RTN","VAFCQRY2",12,0) .;If ICN is identified return Patient Information "RTN","VAFCQRY2",13,0) . I DFN>0 Q "RTN","VAFCQRY2",14,0) . I DFN'>0,$G(SSN)="" S VAFCER="-1^Unknown ICN#"_$G(ICN) Q "RTN","VAFCQRY2",15,0) .;If ICN isn't identified and SSN exists use SSN to identify DFN "RTN","VAFCQRY2",16,0) . I DFN'>0,$G(SSN)'="" S RDFN=$$GETDFNS^MPIF002(SSN) S DFN=+RDFN D Q "RTN","VAFCQRY2",17,0) ..;If LIST contains no matches return negative response "RTN","VAFCQRY2",18,0) .. I DFN=0 S VAFCER="-1^Unknown ICN#"_$G(ICN)_" and SSN#"_$G(SSN) Q "RTN","VAFCQRY2",19,0) ..;If LIST contains only one call check ICN "RTN","VAFCQRY2",20,0) .. I +DFN>0 S ICN=$$GETICN^MPIF001(+DFN) D Q "RTN","VAFCQRY2",21,0) ...;If ICN return patient information. "RTN","VAFCQRY2",22,0) ... I +ICN>0 Q "RTN","VAFCQRY2",23,0) ...;If RDFN does not contain a national ICN return negative response with "Unknown ICN#"_ICN_" and known SSN#"_SSN_" was "_ "RTN","VAFCQRY2",24,0) ... I +ICN'>0 S VAFCER="-1^Unknown ICN#"_$G(ICN)_", SSN#"_$G(SSN)_", DFN#"_$G(DFN)_" was "_$P(RDFN,"^",2) Q "RTN","VAFCQRY2",25,0) ;if DFN is passed "RTN","VAFCQRY2",26,0) I $G(DFN)'="" S ICN=$$GETICN^MPIF001(DFN) D Q "RTN","VAFCQRY2",27,0) .;If ICN is identified return Patient Information "RTN","VAFCQRY2",28,0) . I +ICN>0 Q "RTN","VAFCQRY2",29,0) . I +ICN'>0,$G(SSN)="" S VAFCER="-1^Unknown ICN#"_$G(ICN) Q "RTN","VAFCQRY2",30,0) .;If ICN isn't identified and SSN exists use SSN to identify DFN "RTN","VAFCQRY2",31,0) . I +ICN'>0,SSN'="" S RDFN=$$GETDFNS^MPIF002(SSN) S DFN=+RDFN D Q "RTN","VAFCQRY2",32,0) ..;If LIST contains no matches return negative response "RTN","VAFCQRY2",33,0) .. I +DFN=0 S VAFCER="-1^Unknown ICN#"_$G(ICN)_" for SSN#"_$G(SSN) Q "RTN","VAFCQRY2",34,0) ..;If LIST contains only one, check ICN "RTN","VAFCQRY2",35,0) .. I +DFN>0 S ICN=$$GETICN^MPIF001(DFN) D Q "RTN","VAFCQRY2",36,0) ...;If ICN return patient information. "RTN","VAFCQRY2",37,0) ... I ICN>0 Q "RTN","VAFCQRY2",38,0) ...;If NOT ICN return negative response with "Unknown ICN#"_$G(ICN)_" and known SSN#"_SSN_" was "_ "RTN","VAFCQRY2",39,0) ... S VAFCER="-1^Unknown ICN#"_$G(ICN)_" for known SSN#"_$G(SSN)_" was "_$P(RDFN,"^",2) Q "RTN","VAFCQRY2",40,0) Q "RTN","VAFCQRY2",41,0) BLDEVN(DFN,SEQ,EVN,HL,EVR,ERR) ;build EVN for TF last treatment date and event reason "RTN","VAFCQRY2",42,0) N TFIEN,LTD,TFZN,USERID,COMP,SUBCOMP,USERNAME,USERDUZ "RTN","VAFCQRY2",43,0) S COMP=$E(HL("ECH"),1),SUBCOMP=$E(HL("ECH"),4) "RTN","VAFCQRY2",44,0) S LTD="" "RTN","VAFCQRY2",45,0) ;reset EVR "RTN","VAFCQRY2",46,0) S EVR="" "RTN","VAFCQRY2",47,0) ;S TFIEN=$O(^DGCN(391.91,"APAT",DFN,+$$SITE^VASITE,0)) "RTN","VAFCQRY2",48,0) ;if patient is not already in the associated facility list add "RTN","VAFCQRY2",49,0) D EN1^VAFCTF(DFN,1) S TFIEN=$O(^DGCN(391.91,"APAT",DFN,+$$SITE^VASITE,0)) ;suppress messaging "RTN","VAFCQRY2",50,0) I $G(TFIEN)'="" S TFZN=^DGCN(391.91,TFIEN,0) S LTD=$P(TFZN,"^",3) I +$P(TFZN,"^",7)'=0 S EVR=$$GET1^DIQ(391.91,TFIEN_",",.07) "RTN","VAFCQRY2",51,0) ;**876 - MVI_4449 (ckn) - EVN was populating mismatched DUZ and USERNAME. "RTN","VAFCQRY2",52,0) ;Fix is in place to use appropriate DUZ with USERNAME "RTN","VAFCQRY2",53,0) ;check to see if this is a pivot file trigger if so reset trigger "RTN","VAFCQRY2",54,0) I +$G(PIVOTPTR)>0 I $D(^VAT(391.71,+$G(PIVOTPTR),0)) D "RTN","VAFCQRY2",55,0) . S USERDUZ=$P(^VAT(391.71,+$G(PIVOTPTR),0),"^",9) "RTN","VAFCQRY2",56,0) I $G(USERDUZ)="" S USERDUZ=DUZ "RTN","VAFCQRY2",57,0) S USERNAME=$$GET1^DIQ(200,+USERDUZ_",",.01) "RTN","VAFCQRY2",58,0) S USERNAME=$$HLNAME^HLFNC(USERNAME,HL("ECH")) "RTN","VAFCQRY2",59,0) S USERID=USERDUZ_COMP_$P(USERNAME,COMP)_COMP_$P(USERNAME,COMP,2)_COMP_COMP_COMP_COMP_COMP_COMP_"USVHA"_SUBCOMP_SUBCOMP_"0363"_COMP_"L"_COMP_COMP_COMP_"NI"_COMP_"VA FACILITY ID"_SUBCOMP_$P($$SITE^VASITE,"^",3)_SUBCOMP_"L" "RTN","VAFCQRY2",60,0) I $G(EVN(1))="" S EVN(1)="EVN"_HL("FS")_HL("FS")_$$HLDATE^HLFNC(LTD)_HL("FS")_HL("FS")_HL("FS")_USERID_HL("FS")_$$HLDATE^HLFNC(LTD)_HL("FS")_$P($$SITE^VASITE,"^",3) "RTN","VAFCQRY2",61,0) I $G(EVN(1))'="" S $P(EVN(1),HL("FS"),2)=$G(EVR),$P(EVN(1),HL("FS"),5)=$G(EVR),$P(EVN(1),HL("FS"),3)=$$HLDATE^HLFNC(LTD),$P(EVN(1),HL("FS"),7)=$$HLDATE^HLFNC(LTD),$P(EVN(1),HL("FS"),8)=$P($$SITE^VASITE,"^",3),$P(EVN(1),HL("FS"),6)=USERID "RTN","VAFCQRY2",62,0) Q "RTN","VAFCQRY2",63,0) BLDPD1(DFN,SEQ,PD1,HL,ERR) ; "RTN","VAFCQRY2",64,0) N SITE,VAFCMN,COMP,CMOR "RTN","VAFCQRY2",65,0) S SITE="" "RTN","VAFCQRY2",66,0) S COMP=$E(HL("ECH"),1) "RTN","VAFCQRY2",67,0) ;get Patient File MPI node "RTN","VAFCQRY2",68,0) S VAFCMN=$$MPINODE^MPIFAPI(DFN) "RTN","VAFCQRY2",69,0) S CMOR=$P(VAFCMN,"^",3) "RTN","VAFCQRY2",70,0) I CMOR'="" S SITE=$$NS^XUAF4(CMOR) "RTN","VAFCQRY2",71,0) S PD1(1)="PD1"_HL("FS")_HL("FS")_HL("FS")_$P(SITE,"^")_COMP_"D"_COMP_$P(SITE,"^",2) "RTN","VAFCQRY2",72,0) Q "RTN","VAFCSB") 0^5^B15691481^B8780845 "RTN","VAFCSB",1,0) VAFCSB ;BIR/CMC-CONT ADT PROCESSOR TO RETRIGGER A08 or A04 MESSAGES WITH AL/AL (COMMIT/APPLICATION) ACKNOWLEDGEMENTS ;13 May 2014 4:54 PM "RTN","VAFCSB",2,0) ;;5.3;Registration;**707,756,825,876**;Aug 13, 1993;Build 6 "RTN","VAFCSB",3,0) ; "RTN","VAFCSB",4,0) ;Reference to $$XAMDT^RAO7UTL1 is supported by IA #4875 "RTN","VAFCSB",5,0) ;Reference to RESUTLS^LRPXAPI is supported by IA #4245 "RTN","VAFCSB",6,0) ; "RTN","VAFCSB",7,0) PV2() ;build pv2 segment "RTN","VAFCSB",8,0) N PV2,LSTA,APPT,VASD,VAIP,VARP,VAROOT "RTN","VAFCSB",9,0) S PV2="" "RTN","VAFCSB",10,0) ;get next outpatient appointment "RTN","VAFCSB",11,0) K ^UTILITY("VASD",$J) S VASD("F")=DT D SDA^VADPT "RTN","VAFCSB",12,0) S APPT=$P($G(^UTILITY("VASD",$J,1,"I")),"^") "RTN","VAFCSB",13,0) I APPT'="" S $P(PV2,HL("FS"),9)=$$HLDATE^HLFNC(APPT) "RTN","VAFCSB",14,0) ;GET LAST ADMISSION DATE "RTN","VAFCSB",15,0) K VAIP S VAIP("D")="LAST",VAIP("M")=0 D IN5^VADPT "RTN","VAFCSB",16,0) ; **825,CR_1184: for PV2-14, it will be re-set as the 15th piece "RTN","VAFCSB",17,0) ; in PV2 segment a few lines below "RTN","VAFCSB",18,0) ; I VAIP(2)="1^ADMISSION" S $P(PV2,HL("FS"),15)=$$HLDATE^HLFNC($P(VAIP(3),"^")) "RTN","VAFCSB",19,0) I VAIP(2)="1^ADMISSION" S $P(PV2,HL("FS"),14)=$$HLDATE^HLFNC($P(VAIP(3),"^")) "RTN","VAFCSB",20,0) ;get last registration "RTN","VAFCSB",21,0) S VAROOT="VARP" "RTN","VAFCSB",22,0) D REG^VADPT "RTN","VAFCSB",23,0) I $D(VARP(1,"I")),$G(VARP(1,"I"))>0 S $P(PV2,HL("FS"),46)=$$HLDATE^HLFNC($P(VARP(1,"I"),"^"),"DT"),$P(PV2,HL("FS"),24)="CR" "RTN","VAFCSB",24,0) ;**756 ^ ONLY RETURN DATE FOR LAST REGISTRATION AS HL7 STANDARD CAN ONLY HAVE DATE "RTN","VAFCSB",25,0) I PV2'="" S PV2="PV2"_HL("FS")_PV2 "RTN","VAFCSB",26,0) Q PV2 "RTN","VAFCSB",27,0) PHARA() ;build obx to show active prescriptions "RTN","VAFCSB",28,0) N RET S RET="" "RTN","VAFCSB",29,0) I '$$PATCH^XPDUTL("PSS*1.0*101") Q RET "RTN","VAFCSB",30,0) N PHARM,DGLIST "RTN","VAFCSB",31,0) S PHARM="" D PROF^PSO52API(DFN,"DGLIST") "RTN","VAFCSB",32,0) I +$G(^TMP($J,"DGLIST",DFN,0))>0 S PHARM="OBX"_HL("FS")_HL("FS")_"CE"_HL("FS")_"ACTIVE PRESCRIPTIONS"_HL("FS")_HL("FS")_"Y" "RTN","VAFCSB",33,0) ;**756 CE added as the data type "RTN","VAFCSB",34,0) Q PHARM "RTN","VAFCSB",35,0) SIG(DFN) ;**876 MVI_3467 (ckn) Build OBX for Self Identified Gender "RTN","VAFCSB",36,0) N SIG,SIGE,SIGTMP,OBX S OBX="" "RTN","VAFCSB",37,0) ;I '$$PATCH^XPDUTL("DG*5.3*876") Q OBX "RTN","VAFCSB",38,0) S DIC=2,DA=DFN,DR=".024",DIQ="SIGTMP",DIQ(0)="I,E,N" D EN^DIQ1 "RTN","VAFCSB",39,0) I '$D(SIGTMP) K DA,DR,DIQ Q OBX "RTN","VAFCSB",40,0) S SIG=$G(SIGTMP(2,DFN,DR,"I")),SIGE=$G(SIGTMP(2,DFN,DR,"E")) "RTN","VAFCSB",41,0) S OBX="OBX"_HL("FS")_HL("FS")_"CE"_HL("FS")_"SELF ID GENDER"_HL("FS")_HL("FS")_SIG_$E(HL("ECH"),1)_SIGE "RTN","VAFCSB",42,0) K DA,DR,DIC,DIQ "RTN","VAFCSB",43,0) Q OBX "RTN","VAFCSB",44,0) NAMEOBX(DFN) ;**876,MVI_3453 (mko): Build OBX for Patient .01 and Name Components "RTN","VAFCSB",45,0) N FS "RTN","VAFCSB",46,0) S FS=HL("FS") "RTN","VAFCSB",47,0) Q "OBX"_FS_FS_"CE"_FS_"NAME COMPONENTS"_FS_FS_$$NAMECOMP(DFN,$E(HL("ECH"))) "RTN","VAFCSB",48,0) NAMEERR(DFN) ;**876,MVI_3453 (mko): Build ERR for Patient .01 and Name Components "RTN","VAFCSB",49,0) N CS,SC "RTN","VAFCSB",50,0) S CS=$E(HL("ECH")),SC=$E(HL("ECH"),4) "RTN","VAFCSB",51,0) Q "ERR"_HL("FS")_CS_CS_CS_SC_$$NAMECOMP(DFN,SC) "RTN","VAFCSB",52,0) NAMECOMP(DFN,DELIM) ;**876,MVI_3453 (mko): Return Patient .01 and Name Components "RTN","VAFCSB",53,0) N DIHELP,DIMSG,DIERR,MSG,NC,NCIEN,NCIENS,NCPTR,TARG "RTN","VAFCSB",54,0) S NC=$P($G(^DPT(DFN,0)),"^") "RTN","VAFCSB",55,0) S NCPTR=$P($G(^DPT(DFN,"NAME")),"^") Q:'NCPTR NC "RTN","VAFCSB",56,0) S NCIEN=$$FIND1^DIC(20,"","","`"_NCPTR,"","","MSG") Q:'NCIEN NC "RTN","VAFCSB",57,0) S NCIENS=NCIEN_"," "RTN","VAFCSB",58,0) D GETS^DIQ(20,NCIENS,"1:5","","TARG","MSG") Q:$G(DIERR) NC "RTN","VAFCSB",59,0) S NC=NC_DELIM_TARG(20,NCIENS,1)_DELIM_TARG(20,NCIENS,2)_DELIM_TARG(20,NCIENS,3)_DELIM_TARG(20,NCIENS,5)_DELIM_TARG(20,NCIENS,4) "RTN","VAFCSB",60,0) Q NC "RTN","VAFCSB",61,0) LABE() ;BUILD OBX FOR LAST LAB TEST DATE "RTN","VAFCSB",62,0) N OBX S OBX="" "RTN","VAFCSB",63,0) I '$$PATCH^XPDUTL("LR*5.2*295") Q OBX "RTN","VAFCSB",64,0) N LAB,LAB2,EN "RTN","VAFCSB",65,0) S LAB="" K ^TMP("DGLAB",$J) D RESULTS^LRPXAPI("DGLAB",DFN,"C") "RTN","VAFCSB",66,0) S EN=$O(^TMP("DGLAB",$J,"")) I EN'="" S LAB=$P($G(^TMP("DGLAB",$J,EN)),"^") "RTN","VAFCSB",67,0) K ^TMP("DGLAB",$J) D RESULTS^LRPXAPI("DGLAB",DFN,"A") "RTN","VAFCSB",68,0) S EN=$O(^TMP("DGLAB",$J,"")) I EN'="" S LAB2=$P($G(^TMP("DGLAB",$J,EN)),"^") I LAB2>LAB S LAB=LAB2 "RTN","VAFCSB",69,0) K ^TMP("DGLAB",$J) D RESULTS^LRPXAPI("DGLAB",DFN,"M") "RTN","VAFCSB",70,0) S EN=$O(^TMP("DGLAB",$J,"")) I EN'="" S LAB2=$P($G(^TMP("DGLAB",$J,EN)),"^") I LAB2>LAB S LAB=LAB2 "RTN","VAFCSB",71,0) I LAB'="" D "RTN","VAFCSB",72,0) .S $P(OBX,HL("FS"),2)="TS" ;**756 added the data type "RTN","VAFCSB",73,0) .S $P(OBX,HL("FS"),3)="LAST LAB TEST DATE/TIME" "RTN","VAFCSB",74,0) .S $P(OBX,HL("FS"),11)="F" "RTN","VAFCSB",75,0) .S $P(OBX,HL("FS"),14)=$$HLDATE^HLFNC(LAB) "RTN","VAFCSB",76,0) .S OBX="OBX"_HL("FS")_OBX "RTN","VAFCSB",77,0) Q OBX "RTN","VAFCSB",78,0) RADE() ;BUILD OBX FOR LAST RADIOLOGY TEST DATE "RTN","VAFCSB",79,0) N RET S RET="" "RTN","VAFCSB",80,0) I '$$PATCH^XPDUTL("RA*5.0*76") Q RET "RTN","VAFCSB",81,0) N RAD,RADE "RTN","VAFCSB",82,0) S RAD="",RADE=$$XAMDT^RAO7UTL1(DFN) I +RADE<1 Q RAD "RTN","VAFCSB",83,0) I +RADE>0 D "RTN","VAFCSB",84,0) .S $P(OBX,HL("FS"),2)="TS" ;**756 added the data type "RTN","VAFCSB",85,0) .S $P(RAD,HL("FS"),3)="LAST RADIOLOGY EXAM DATE/TIME" "RTN","VAFCSB",86,0) .S $P(RAD,HL("FS"),11)="F" "RTN","VAFCSB",87,0) .S $P(RAD,HL("FS"),14)=$$HLDATE^HLFNC(RADE) "RTN","VAFCSB",88,0) .S RAD="OBX"_HL("FS")_RAD "RTN","VAFCSB",89,0) Q RAD "RTN","VAFCSB",90,0) PD1() ;BUILD PD1 segment "RTN","VAFCSB",91,0) ;PREFERRED FACILITY -- NOT GOING TO BE PASSED PER IMDQ 9/7/06 "RTN","VAFCSB",92,0) N TEAM,PD1 "RTN","VAFCSB",93,0) S PD1="" "RTN","VAFCSB",94,0) ;S TEAM=$$PREF^DGENPTA(DFN) "RTN","VAFCSB",95,0) ;I TEAM'="" S PD1="PD1"_HL("FS")_HL("FS")_HL("FS")_$$STA^XUAF4(TEAM) "RTN","VAFCSB",96,0) Q PD1 "RTN","VAFCSB",97,0) PV1() ;BUILD PV1 SEGMENT "RTN","VAFCSB",98,0) ;CURRENTLY ADMITTED? "RTN","VAFCSB",99,0) N PV1,VAINDT "RTN","VAFCSB",100,0) S PV1="" "RTN","VAFCSB",101,0) S VAINDT=DT "RTN","VAFCSB",102,0) D INP^VADPT "RTN","VAFCSB",103,0) I $G(VAIN(1))'="" S $P(PV1,HL("FS"),44)=$$HLDATE^HLFNC($P(VAIN(7),"^")),PV1="PV1"_HL("FS")_PV1 "RTN","VAFCSB",104,0) K VAIN "RTN","VAFCSB",105,0) Q PV1 "RTN","VAFCTR") 0^7^B3892761^B2482346 "RTN","VAFCTR",1,0) VAFCTR ;BIR/CMC,ERC,PTD-Monitoring fields for MPI/PD via DG field monitoring ; 3/30/07 "RTN","VAFCTR",2,0) ;;5.3;Registration;**575,648,653,712,876**;Aug 13, 1993;Build 6 "RTN","VAFCTR",3,0) Q ; quit if called from the top "RTN","VAFCTR",4,0) ; "RTN","VAFCTR",5,0) MPIPD ; protocol entry point for monitoring fields via DG field monitoring "RTN","VAFCTR",6,0) ; Currently monitoring for fields: "RTN","VAFCTR",7,0) ; 1 ALIAS - .01 of the multiple "RTN","VAFCTR",8,0) ; 2 RACE INFORMATION - .01 of the multiple "RTN","VAFCTR",9,0) ; 6 ETHNICITY INFORMATION - .01 of the multiple "RTN","VAFCTR",10,0) ; 994 MULTIPLE BIRTH INDICATOR "RTN","VAFCTR",11,0) ; .525 POW STAUTS INDICATED? "RTN","VAFCTR",12,0) ; .0906 PSEUDO SSN REASON "RTN","VAFCTR",13,0) ; .121 BAD ADDRESS INDICATOR "RTN","VAFCTR",14,0) ; .133 EMAIL ADDRESS "RTN","VAFCTR",15,0) ; .134 PHONE NUMBER [CELLULAR] "RTN","VAFCTR",16,0) ; .024 SELF IDENTIFIED GENDER **876 "RTN","VAFCTR",17,0) ; 391 TYPE ;**876 "RTN","VAFCTR",18,0) ; 1901 VETERAN Y/N? **876 "RTN","VAFCTR",19,0) ; .323 PERIOD OF SERVICE **876 "RTN","VAFCTR",20,0) ; "RTN","VAFCTR",21,0) I $G(DGFILE)'=2&($G(DGFILE)'=2.01)&($G(DGFILE)'=2.02)&($G(DGFILE)'=2.06) Q "RTN","VAFCTR",22,0) S DGFIELD=$G(DGFIELD) "RTN","VAFCTR",23,0) I DGFIELD'=.01&(DGFIELD'=994)&(DGFIELD'=.525)&(DGFIELD'=.0906)&(DGFIELD'=.121)&(DGFIELD'=.133)&(DGFIELD'=.134)&(DGFIELD'=391)&(DGFIELD'=1901)&(DGFIELD'=.323)&(DGFIELD'=.024) Q "RTN","VAFCTR",24,0) I $T(AVAFC^VAFCDD01)="" Q "RTN","VAFCTR",25,0) ;The fields below are not multiples "RTN","VAFCTR",26,0) I (DGFIELD=994)!(DGFIELD=.525)!(DGFIELD=.0906)!(DGFIELD=.121)!(DGFIELD=.133)!(DGFIELD=.134)!(DGFIELD=.024)!(DGFIELD=391)!(DGFIELD=1901)!(DGFIELD=.323) S VAFCF=DGFIELD_";" D AVAFC^VAFCDD01(DGDA) "RTN","VAFCTR",27,0) ;The fields below ARE multiples "RTN","VAFCTR",28,0) I DGFILE=2.01 S VAFCF="1;" D AVAFC^VAFCDD01(DGDA(1)) ;ALIAS "RTN","VAFCTR",29,0) I DGFILE=2.02 S VAFCF="2.02,.01;" D AVAFC^VAFCDD01(DGDA(1)) ;RACE INFORMATION "RTN","VAFCTR",30,0) I DGFILE=2.06 S VAFCF="2.06,.01;" D AVAFC^VAFCDD01(DGDA(1)) ;ETHNICITY INFORMATION "RTN","VAFCTR",31,0) Q "VER") 8.0^22.0 "^DD",2,2,.024,0) SELF IDENTIFIED GENDER^Sa^M:Male;F:Female;TM:Transmale/Transman/Female-to-Male;TF:Transfemale/Transwoman/Male-to-Female;O:Other;N:individual chooses not to answer;^.24;4^Q "^DD",2,2,.024,3) Select the code that specifies the patient's preferred gender. "^DD",2,2,.024,21,0) ^^1^1^3140108^ "^DD",2,2,.024,21,1,0) This SELF IDENTIFIED GENDER value indicates the patient's view of their sexual orientation, if they choose to provide it. "^DD",2,2,.024,"AUDIT") y "^DD",2,2,.024,"DT") 3140106 "BLD",3007,6) ^784 **END** **END**