Released DG*5.3*1059 SEQ #929 Extracted from mail message **KIDS**:DG*5.3*1059^ **INSTALL NAME** DG*5.3*1059 "BLD",3657,0) DG*5.3*1059^REGISTRATION^0^3211025^y "BLD",3657,1,0) ^9.61A^3^3^3211025^^^^ "BLD",3657,1,1,0) MASTER VETERAN INDEX VISTA ENHANCEMENT - NEW DEMOGRAPHIC FIELDS "BLD",3657,1,2,0) Refer to patch DG*5.3*1059 in the FORUM Patch Module for a complete "BLD",3657,1,3,0) description. "BLD",3657,4,0) ^9.64PA^47.78^3 "BLD",3657,4,2,0) 2 "BLD",3657,4,2,2,0) ^9.641^2^3 "BLD",3657,4,2,2,2,0) PATIENT (File-top level) "BLD",3657,4,2,2,2,1,0) ^9.6411^.11573^12 "BLD",3657,4,2,2,2,1,.0251,0) SEXUAL ORIENTATION DESCRIPTION "BLD",3657,4,2,2,2,1,.1151,0) RESIDENTIAL ADDRESS [LINE 1] "BLD",3657,4,2,2,2,1,.1152,0) RESIDENTIAL ADDRESS [LINE 2] "BLD",3657,4,2,2,2,1,.1153,0) RESIDENTIAL ADDRESS [LINE 3] "BLD",3657,4,2,2,2,1,.1154,0) RESIDENTIAL CITY "BLD",3657,4,2,2,2,1,.1155,0) RESIDENTIAL STATE "BLD",3657,4,2,2,2,1,.1156,0) RESIDENTIAL ZIP+4 "BLD",3657,4,2,2,2,1,.11571,0) RESIDENTIAL PROVINCE "BLD",3657,4,2,2,2,1,.11572,0) RESIDENTIAL POSTAL CODE "BLD",3657,4,2,2,2,1,.11573,0) RESIDENTIAL COUNTRY "BLD",3657,4,2,2,2,1,.24061,0) PRONOUN DESCRIPTION "BLD",3657,4,2,2,2,1,991.11,0) INDIVIDUAL TAX ID "BLD",3657,4,2,2,2.025,0) SEXUAL ORIENTATION (sub-file) "BLD",3657,4,2,2,2.025,1,0) ^9.6411^.01^1 "BLD",3657,4,2,2,2.025,1,.01,0) SEXUAL ORIENTATION "BLD",3657,4,2,2,2.2406,0) PRONOUN (sub-file) "BLD",3657,4,2,2,2.2406,1,0) ^9.6411^.01^1 "BLD",3657,4,2,2,2.2406,1,.01,0) PRONOUN "BLD",3657,4,2,222) y^n^p^^^^n^^n "BLD",3657,4,2,224) "BLD",3657,4,47.77,0) 47.77 "BLD",3657,4,47.77,222) y^y^f^^n^^y^o^n "BLD",3657,4,47.78,0) 47.78 "BLD",3657,4,47.78,222) y^y^f^^n^^y^o^n "BLD",3657,4,"APDD",2,2) "BLD",3657,4,"APDD",2,2,.0251) "BLD",3657,4,"APDD",2,2,.1151) "BLD",3657,4,"APDD",2,2,.1152) "BLD",3657,4,"APDD",2,2,.1153) "BLD",3657,4,"APDD",2,2,.1154) "BLD",3657,4,"APDD",2,2,.1155) "BLD",3657,4,"APDD",2,2,.1156) "BLD",3657,4,"APDD",2,2,.11571) "BLD",3657,4,"APDD",2,2,.11572) "BLD",3657,4,"APDD",2,2,.11573) "BLD",3657,4,"APDD",2,2,.24061) "BLD",3657,4,"APDD",2,2,991.11) "BLD",3657,4,"APDD",2,2.025) "BLD",3657,4,"APDD",2,2.025,.01) "BLD",3657,4,"APDD",2,2.2406) "BLD",3657,4,"APDD",2,2.2406,.01) "BLD",3657,4,"B",2,2) "BLD",3657,4,"B",47.77,47.77) "BLD",3657,4,"B",47.78,47.78) "BLD",3657,6) 4^ "BLD",3657,6.3) 6 "BLD",3657,"ABPKG") n "BLD",3657,"KRN",0) ^9.67PA^1.5^25 "BLD",3657,"KRN",.4,0) .4 "BLD",3657,"KRN",.401,0) .401 "BLD",3657,"KRN",.402,0) .402 "BLD",3657,"KRN",.403,0) .403 "BLD",3657,"KRN",.5,0) .5 "BLD",3657,"KRN",.84,0) .84 "BLD",3657,"KRN",1.5,0) 1.5 "BLD",3657,"KRN",1.6,0) 1.6 "BLD",3657,"KRN",1.61,0) 1.61 "BLD",3657,"KRN",1.62,0) 1.62 "BLD",3657,"KRN",3.6,0) 3.6 "BLD",3657,"KRN",3.8,0) 3.8 "BLD",3657,"KRN",9.2,0) 9.2 "BLD",3657,"KRN",9.8,0) 9.8 "BLD",3657,"KRN",9.8,"NM",0) ^9.68A^10^10 "BLD",3657,"KRN",9.8,"NM",1,0) VADPT1^^0^B68594806 "BLD",3657,"KRN",9.8,"NM",2,0) VADPT0^^0^B15146379 "BLD",3657,"KRN",9.8,"NM",3,0) VAFCPDAT^^0^B83449271 "BLD",3657,"KRN",9.8,"NM",4,0) DGRPD^^0^B124542170 "BLD",3657,"KRN",9.8,"NM",5,0) VAFCTR^^0^B12937603 "BLD",3657,"KRN",9.8,"NM",6,0) VAFCSB^^0^B75363862 "BLD",3657,"KRN",9.8,"NM",7,0) VAFCQRY^^0^B34739749 "BLD",3657,"KRN",9.8,"NM",8,0) VAFCPTED^^0^B71161644 "BLD",3657,"KRN",9.8,"NM",9,0) VAFCQRY1^^0^B102699119 "BLD",3657,"KRN",9.8,"NM",10,0) VAFCHFS^^0^B33066545 "BLD",3657,"KRN",9.8,"NM","B","DGRPD",4) "BLD",3657,"KRN",9.8,"NM","B","VADPT0",2) "BLD",3657,"KRN",9.8,"NM","B","VADPT1",1) "BLD",3657,"KRN",9.8,"NM","B","VAFCHFS",10) "BLD",3657,"KRN",9.8,"NM","B","VAFCPDAT",3) "BLD",3657,"KRN",9.8,"NM","B","VAFCPTED",8) "BLD",3657,"KRN",9.8,"NM","B","VAFCQRY",7) "BLD",3657,"KRN",9.8,"NM","B","VAFCQRY1",9) "BLD",3657,"KRN",9.8,"NM","B","VAFCSB",6) "BLD",3657,"KRN",9.8,"NM","B","VAFCTR",5) "BLD",3657,"KRN",19,0) 19 "BLD",3657,"KRN",19.1,0) 19.1 "BLD",3657,"KRN",101,0) 101 "BLD",3657,"KRN",409.61,0) 409.61 "BLD",3657,"KRN",771,0) 771 "BLD",3657,"KRN",779.2,0) 779.2 "BLD",3657,"KRN",870,0) 870 "BLD",3657,"KRN",8989.51,0) 8989.51 "BLD",3657,"KRN",8989.52,0) 8989.52 "BLD",3657,"KRN",8993,0) 8993 "BLD",3657,"KRN",8994,0) 8994 "BLD",3657,"KRN","B",.4,.4) "BLD",3657,"KRN","B",.401,.401) "BLD",3657,"KRN","B",.402,.402) "BLD",3657,"KRN","B",.403,.403) "BLD",3657,"KRN","B",.5,.5) "BLD",3657,"KRN","B",.84,.84) "BLD",3657,"KRN","B",1.5,1.5) "BLD",3657,"KRN","B",1.6,1.6) "BLD",3657,"KRN","B",1.61,1.61) "BLD",3657,"KRN","B",1.62,1.62) "BLD",3657,"KRN","B",3.6,3.6) "BLD",3657,"KRN","B",3.8,3.8) "BLD",3657,"KRN","B",9.2,9.2) "BLD",3657,"KRN","B",9.8,9.8) "BLD",3657,"KRN","B",19,19) "BLD",3657,"KRN","B",19.1,19.1) "BLD",3657,"KRN","B",101,101) "BLD",3657,"KRN","B",409.61,409.61) "BLD",3657,"KRN","B",771,771) "BLD",3657,"KRN","B",779.2,779.2) "BLD",3657,"KRN","B",870,870) "BLD",3657,"KRN","B",8989.51,8989.51) "BLD",3657,"KRN","B",8989.52,8989.52) "BLD",3657,"KRN","B",8993,8993) "BLD",3657,"KRN","B",8994,8994) "BLD",3657,"QDEF") ^^^^NO^^^^NO^^YES "BLD",3657,"QUES",0) ^9.62^^ "BLD",3657,"REQB",0) ^9.611^8^7 "BLD",3657,"REQB",1,0) DG*5.3*941^2 "BLD",3657,"REQB",2,0) DG*5.3*950^2 "BLD",3657,"REQB",3,0) DG*5.3*967^2 "BLD",3657,"REQB",4,0) DG*5.3*974^2 "BLD",3657,"REQB",5,0) DG*5.3*981^2 "BLD",3657,"REQB",6,0) DG*5.3*996^2 "BLD",3657,"REQB",8,0) DG*5.3*1061^2 "BLD",3657,"REQB","B","DG*5.3*1061",8) "BLD",3657,"REQB","B","DG*5.3*941",1) "BLD",3657,"REQB","B","DG*5.3*950",2) "BLD",3657,"REQB","B","DG*5.3*967",3) "BLD",3657,"REQB","B","DG*5.3*974",4) "BLD",3657,"REQB","B","DG*5.3*981",5) "BLD",3657,"REQB","B","DG*5.3*996",6) "DATA",47.77,1,0) Lesbian, Gay or Homosexual^LGH "DATA",47.77,2,0) Straight or Heterosexual^STH "DATA",47.77,3,0) Bisexual^BIS "DATA",47.77,4,0) Queer^QER "DATA",47.77,5,0) Another Option, please describe^OTH "DATA",47.77,6,0) Don't know^DTK "DATA",47.77,7,0) Choose not to disclose^CND "DATA",47.78,1,0) He/Him/His^HIS "DATA",47.78,2,0) She/Her/Hers^HER "DATA",47.78,3,0) They/Them/Theirs^THE "DATA",47.78,4,0) Ze/Zir/Zirs^ZIR "DATA",47.78,5,0) Patient Name^PTN "DATA",47.78,6,0) Other^OTH "FIA",2) PATIENT "FIA",2,0) ^DPT( "FIA",2,0,0) 2I "FIA",2,0,1) y^n^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,.025) "FIA",2,2,.0251) "FIA",2,2,.1151) "FIA",2,2,.1152) "FIA",2,2,.1153) "FIA",2,2,.1154) "FIA",2,2,.1155) "FIA",2,2,.1156) "FIA",2,2,.11571) "FIA",2,2,.11572) "FIA",2,2,.11573) "FIA",2,2,.2406) "FIA",2,2,.24061) "FIA",2,2,991.11) "FIA",2,2.025) 1 "FIA",2,2.025,.01) "FIA",2,2.2406) 1 "FIA",2,2.2406,.01) "FIA",47.77) SEXUAL ORIENTATION TYPES "FIA",47.77,0) ^DG(47.77, "FIA",47.77,0,0) 47.77 "FIA",47.77,0,1) y^y^f^^n^^y^o^n "FIA",47.77,0,10) "FIA",47.77,0,11) "FIA",47.77,0,"RLRO") "FIA",47.77,0,"VR") 5.3^DG "FIA",47.77,47.77) 0 "FIA",47.78) PRONOUN TYPES "FIA",47.78,0) ^DG(47.78, "FIA",47.78,0,0) 47.78 "FIA",47.78,0,1) y^y^f^^n^^y^o^n "FIA",47.78,0,10) "FIA",47.78,0,11) "FIA",47.78,0,"RLRO") "FIA",47.78,0,"VR") 5.3^DG "FIA",47.78,47.78) 0 "IX",2,2,"ADTTM8",0) 2^ADTTM8^RESIDENTIAL ADDRESS Cross-Reference^MU^^R^^I^2^^^^^A "IX",2,2,"ADTTM8",.1,0) ^^2^2^3170731^^ "IX",2,2,"ADTTM8",.1,1,0) This cross-reference will update the RESIDENTIAL ADDR CHANGE DT/TM field "IX",2,2,"ADTTM8",.1,2,0) when the Residential Address data changes for a patient. "IX",2,2,"ADTTM8",1) D RES^DGDDDTTM "IX",2,2,"ADTTM8",2) D RES^DGDDDTTM "IX",2,2,"ADTTM8",11.1,0) ^.114IA^9^9 "IX",2,2,"ADTTM8",11.1,1,0) 1^F^2^.1151^^^F "IX",2,2,"ADTTM8",11.1,1,3) "IX",2,2,"ADTTM8",11.1,2,0) 2^F^2^.1152^^^F "IX",2,2,"ADTTM8",11.1,2,3) "IX",2,2,"ADTTM8",11.1,3,0) 3^F^2^.1153^^^F "IX",2,2,"ADTTM8",11.1,3,3) "IX",2,2,"ADTTM8",11.1,4,0) 4^F^2^.1154^^^F "IX",2,2,"ADTTM8",11.1,4,3) "IX",2,2,"ADTTM8",11.1,5,0) 5^F^2^.1155^^^F "IX",2,2,"ADTTM8",11.1,5,3) "IX",2,2,"ADTTM8",11.1,6,0) 6^F^2^.1156^^^F "IX",2,2,"ADTTM8",11.1,6,3) "IX",2,2,"ADTTM8",11.1,7,0) 7^F^2^.11571^^^F "IX",2,2,"ADTTM8",11.1,7,3) "IX",2,2,"ADTTM8",11.1,8,0) 8^F^2^.11572^^^F "IX",2,2,"ADTTM8",11.1,8,3) "IX",2,2,"ADTTM8",11.1,9,0) 9^F^2^.11573^^^F "IX",2,2,"ADTTM8",11.1,9,3) "IX",2,2,"AVAFC0251",0) 2^AVAFC0251^This x-ref calls the DG FIELD MONITOR event point.^MU^^F^I^I^2^^^^^A "IX",2,2,"AVAFC0251",.1,0) ^^5^5^3210628^ "IX",2,2,"AVAFC0251",.1,1,0) This cross-reference activates the DG FIELD MONITOR event point. "IX",2,2,"AVAFC0251",.1,2,0) Applications that wish to monitor edit activity related to this field may "IX",2,2,"AVAFC0251",.1,3,0) subscribe to that event point and take action as indicated by the changes "IX",2,2,"AVAFC0251",.1,4,0) that occur. Refer to the DG FIELD MONITOR protocol for a description of "IX",2,2,"AVAFC0251",.1,5,0) the information available at the time of the event. "IX",2,2,"AVAFC0251",1) D FC^DGFCPROT(.DA,2,.0251,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC0251",2) D FC^DGFCPROT(.DA,2,.0251,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC0251",11.1,0) ^.114IA^1^1 "IX",2,2,"AVAFC0251",11.1,1,0) 1^F^2^.0251^^^F "IX",2,2,"AVAFC0251",11.1,1,3) "IX",2,2,"AVAFC1151",0) 2^AVAFC1151^This x-ref calls the DG Field Monitor event point.^MU^^F^I^I^2^^^^^A "IX",2,2,"AVAFC1151",.1,0) ^^5^5^3210713^ "IX",2,2,"AVAFC1151",.1,1,0) This cross-reference activates the DG FIELD MONITOR event point. "IX",2,2,"AVAFC1151",.1,2,0) Applications that wish to monitor edit activity related to this field may "IX",2,2,"AVAFC1151",.1,3,0) subscribe to that event point and take action as indicated by the changes "IX",2,2,"AVAFC1151",.1,4,0) that occur. Refer to the DG FIELD MONITOR protocol for a description of "IX",2,2,"AVAFC1151",.1,5,0) the information available at the time of the event. "IX",2,2,"AVAFC1151",1) D FC^DGFCPROT(.DA,2,.1151,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC1151",2) D FC^DGFCPROT(.DA,2,.1151,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC1151",11.1,0) ^.114IA^1^1 "IX",2,2,"AVAFC1151",11.1,1,0) 1^F^2^.1151^^^F "IX",2,2,"AVAFC1151",11.1,1,3) "IX",2,2,"AVAFC1152",0) 2^AVAFC1152^This x-ref calls the DG Field Monitor event point.^MU^^F^I^I^2^^^^^A "IX",2,2,"AVAFC1152",.1,0) ^^5^5^3210713^ "IX",2,2,"AVAFC1152",.1,1,0) This cross-reference activates the DG FIELD MONITOR event point. "IX",2,2,"AVAFC1152",.1,2,0) Applications that wish to monitor edit activity related to this field may "IX",2,2,"AVAFC1152",.1,3,0) subscribe to that event point and take action as indicated by the changes "IX",2,2,"AVAFC1152",.1,4,0) that occur. Refer to the DG FIELD MONITOR protocol for a description of "IX",2,2,"AVAFC1152",.1,5,0) the information available at the time of the event. "IX",2,2,"AVAFC1152",1) D FC^DGFCPROT(.DA,2,.1152,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC1152",2) D FC^DGFCPROT(.DA,2,.1152,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC1152",11.1,0) ^.114IA^1^1 "IX",2,2,"AVAFC1152",11.1,1,0) 1^F^2^.1152^^^F "IX",2,2,"AVAFC1152",11.1,1,3) "IX",2,2,"AVAFC1153",0) 2^AVAFC1153^This x-ref calls the DG Field Monitor event point.^MU^^F^I^I^2^^^^^A "IX",2,2,"AVAFC1153",.1,0) ^^5^5^3210713^ "IX",2,2,"AVAFC1153",.1,1,0) This cross-reference activates the DG FIELD MONITOR event point. "IX",2,2,"AVAFC1153",.1,2,0) Applications that wish to monitor edit activity related to this field may "IX",2,2,"AVAFC1153",.1,3,0) subscribe to that event point and take action as indicated by the changes "IX",2,2,"AVAFC1153",.1,4,0) that occur. Refer to the DG FIELD MONITOR protocol for a description of "IX",2,2,"AVAFC1153",.1,5,0) the information available at the time of the event. "IX",2,2,"AVAFC1153",1) D FC^DGFCPROT(.DA,2,.1153,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC1153",2) D FC^DGFCPROT(.DA,2,.1153,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC1153",11.1,0) ^.114IA^1^1 "IX",2,2,"AVAFC1153",11.1,1,0) 1^F^2^.1153^^^F "IX",2,2,"AVAFC1153",11.1,1,3) "IX",2,2,"AVAFC1154",0) 2^AVAFC1154^This x-ref calls the DG Field Monitor event point.^MU^^F^I^I^2^^^^^A "IX",2,2,"AVAFC1154",.1,0) ^^5^5^3210713^ "IX",2,2,"AVAFC1154",.1,1,0) This cross-reference activates the DG FIELD MONITOR event point. "IX",2,2,"AVAFC1154",.1,2,0) Applications that wish to monitor edit activity related to this field may "IX",2,2,"AVAFC1154",.1,3,0) subscribe to that event point and take action as indicated by the changes "IX",2,2,"AVAFC1154",.1,4,0) that occur. Refer to the DG FIELD MONITOR protocol for a description of "IX",2,2,"AVAFC1154",.1,5,0) the information available at the time of the event. "IX",2,2,"AVAFC1154",1) D FC^DGFCPROT(.DA,2,.1154,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC1154",2) D FC^DGFCPROT(.DA,2,.1154,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC1154",11.1,0) ^.114IA^1^1 "IX",2,2,"AVAFC1154",11.1,1,0) 1^F^2^.1154^^^F "IX",2,2,"AVAFC1154",11.1,1,3) "IX",2,2,"AVAFC1155",0) 2^AVAFC1155^This x-ref calls the DG Field Monitor event point.^MU^^F^I^I^2^^^^^A "IX",2,2,"AVAFC1155",.1,0) ^^5^5^3210713^ "IX",2,2,"AVAFC1155",.1,1,0) This cross-reference activates the DG FIELD MONITOR event point. "IX",2,2,"AVAFC1155",.1,2,0) Applications that wish to monitor edit activity related to this field may "IX",2,2,"AVAFC1155",.1,3,0) subscribe to that event point and take action as indicated by the changes "IX",2,2,"AVAFC1155",.1,4,0) that occur. Refer to the DG FIELD MONITOR protocol for a description of "IX",2,2,"AVAFC1155",.1,5,0) the information available at the time of the event. "IX",2,2,"AVAFC1155",1) D FC^DGFCPROT(.DA,2,.1155,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC1155",2) D FC^DGFCPROT(.DA,2,.1155,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC1155",11.1,0) ^.114IA^1^1 "IX",2,2,"AVAFC1155",11.1,1,0) 1^F^2^.1155^^^F "IX",2,2,"AVAFC1155",11.1,1,3) "IX",2,2,"AVAFC1156",0) 2^AVAFC1156^This x-ref calls the DG Field Monitor event point.^MU^^F^I^I^2^^^^^A "IX",2,2,"AVAFC1156",.1,0) ^^5^5^3210713^ "IX",2,2,"AVAFC1156",.1,1,0) This cross-reference activates the DG FIELD MONITOR event point. "IX",2,2,"AVAFC1156",.1,2,0) Applications that wish to monitor edit activity related to this field may "IX",2,2,"AVAFC1156",.1,3,0) subscribe to that event point and take action as indicated by the changes "IX",2,2,"AVAFC1156",.1,4,0) that occur. Refer to the DG FIELD MONITOR protocol for a description of "IX",2,2,"AVAFC1156",.1,5,0) the information available at the time of the event. "IX",2,2,"AVAFC1156",1) D FC^DGFCPROT(.DA,2,.1156,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC1156",2) D FC^DGFCPROT(.DA,2,.1156,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC1156",11.1,0) ^.114IA^1^1 "IX",2,2,"AVAFC1156",11.1,1,0) 1^F^2^.1156^^^F "IX",2,2,"AVAFC1156",11.1,1,3) "IX",2,2,"AVAFC11571",0) 2^AVAFC11571^This x-ref calls the DG Field Monitor event point.^MU^^F^I^I^2^^^^^A "IX",2,2,"AVAFC11571",.1,0) ^^5^5^3210713^ "IX",2,2,"AVAFC11571",.1,1,0) This cross-reference activates the DG FIELD MONITOR event point. "IX",2,2,"AVAFC11571",.1,2,0) Applications that wish to monitor edit activity related to this field may "IX",2,2,"AVAFC11571",.1,3,0) subscribe to that event point and take action as indicated by the changes "IX",2,2,"AVAFC11571",.1,4,0) that occur. Refer to the DG FIELD MONITOR protocol for a description of "IX",2,2,"AVAFC11571",.1,5,0) the information available at the time of the event. "IX",2,2,"AVAFC11571",1) D FC^DGFCPROT(.DA,2,.11571,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC11571",2) D FC^DGFCPROT(.DA,2,.11571,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC11571",11.1,0) ^.114IA^1^1 "IX",2,2,"AVAFC11571",11.1,1,0) 1^F^2^.11571^^^F "IX",2,2,"AVAFC11571",11.1,1,3) "IX",2,2,"AVAFC11572",0) 2^AVAFC11572^This x-ref calls the DG Field Monitor event point.^MU^^F^I^I^2^^^^^A "IX",2,2,"AVAFC11572",.1,0) ^^5^5^3210713^ "IX",2,2,"AVAFC11572",.1,1,0) This cross-reference activates the DG FIELD MONITOR event point. "IX",2,2,"AVAFC11572",.1,2,0) Applications that wish to monitor edit activity related to this field may "IX",2,2,"AVAFC11572",.1,3,0) subscribe to that event point and take action as indicated by the changes "IX",2,2,"AVAFC11572",.1,4,0) that occur. Refer to the DG FIELD MONITOR protocol for a description of "IX",2,2,"AVAFC11572",.1,5,0) the information available at the time of the event. "IX",2,2,"AVAFC11572",1) D FC^DGFCPROT(.DA,2,.11572,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC11572",2) D FC^DGFCPROT(.DA,2,.11572,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC11572",11.1,0) ^.114IA^1^1 "IX",2,2,"AVAFC11572",11.1,1,0) 1^F^2^.11572^^^F "IX",2,2,"AVAFC11572",11.1,1,3) "IX",2,2,"AVAFC11573",0) 2^AVAFC11573^This x-ref calls the DG Field Monitor event point.^MU^^F^I^I^2^^^^^A "IX",2,2,"AVAFC11573",.1,0) ^^5^5^3210713^ "IX",2,2,"AVAFC11573",.1,1,0) This cross-reference activates the DG FIELD MONITOR event point. "IX",2,2,"AVAFC11573",.1,2,0) Applications that wish to monitor edit activity related to this field may "IX",2,2,"AVAFC11573",.1,3,0) subscribe to that event point and take action as indicated by the changes "IX",2,2,"AVAFC11573",.1,4,0) that occur. Refer to the DG FIELD MONITOR protocol for a description of "IX",2,2,"AVAFC11573",.1,5,0) the information available at the time of the event. "IX",2,2,"AVAFC11573",1) D FC^DGFCPROT(.DA,2,.11573,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC11573",2) D FC^DGFCPROT(.DA,2,.11573,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC11573",11.1,0) ^.114IA^1^1 "IX",2,2,"AVAFC11573",11.1,1,0) 1^F^2^.11573^^^F "IX",2,2,"AVAFC11573",11.1,1,3) "IX",2,2,"AVAFC24061",0) 2^AVAFC24061^This x-ref calls the DG FIELD MONITOR event point.^MU^^F^I^I^2^^^^^A "IX",2,2,"AVAFC24061",.1,0) ^^5^5^3210624^ "IX",2,2,"AVAFC24061",.1,1,0) This cross-reference activates the DG FIELD MONITOR event point. "IX",2,2,"AVAFC24061",.1,2,0) Applications that wish to monitor edit activity related to this field may "IX",2,2,"AVAFC24061",.1,3,0) subscribe to that event point and take action as indicated by the changes "IX",2,2,"AVAFC24061",.1,4,0) that occur. Refer to the DG FIELD MONITOR protocol for a description of "IX",2,2,"AVAFC24061",.1,5,0) the information available at the time of the event. "IX",2,2,"AVAFC24061",1) D FC^DGFCPROT(.DA,2,.24061,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC24061",2) D FC^DGFCPROT(.DA,2,.24061,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC24061",11.1,0) ^.114IA^1^1 "IX",2,2,"AVAFC24061",11.1,1,0) 1^F^2^.24061^^^F "IX",2,2,"AVAFC24061",11.1,1,3) "IX",2,2,"AVAFC99111",0) 2^AVAFC99111^This x-ref calls the DG FIELD MONITOR event point.^MU^^F^I^I^2^^^^^A "IX",2,2,"AVAFC99111",.1,0) ^^5^5^3210624^ "IX",2,2,"AVAFC99111",.1,1,0) This cross-reference activates the DG FIELD MONITOR event point. "IX",2,2,"AVAFC99111",.1,2,0) Applications that wish to monitor edit activity related to this field may "IX",2,2,"AVAFC99111",.1,3,0) subscribe to that event point and take action as indicated by the changes "IX",2,2,"AVAFC99111",.1,4,0) that occur. Refer to the DG FIELD MONITOR protocol for a description of "IX",2,2,"AVAFC99111",.1,5,0) the information available at the time of the event. "IX",2,2,"AVAFC99111",1) D FC^DGFCPROT(.DA,2,991.11,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC99111",2) D FC^DGFCPROT(.DA,2,991.11,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC99111",11.1,0) ^.114IA^1^1 "IX",2,2,"AVAFC99111",11.1,1,0) 1^F^2^991.11^^^F "IX",2,2,"AXRCTNRY",0) 2^AXRCTNRY^Clear Residential Addr fields when country changes^MU^^F^R^I^2^^^^^A "IX",2,2,"AXRCTNRY",.1,0) ^^9^9^3180215^ "IX",2,2,"AXRCTNRY",.1,1,0) This cross reference is fired whenever the field RESIDENTIAL ADDRESS "IX",2,2,"AXRCTNRY",.1,2,0) COUNTRY is changed. It will clear data in fields associated with whether "IX",2,2,"AXRCTNRY",.1,3,0) the COUNTRY value is domestic or foreign. In the case of a foreign "IX",2,2,"AXRCTNRY",.1,4,0) address, this cross reference will clear the RESIDENTIAL ADDRESS STATE, "IX",2,2,"AXRCTNRY",.1,5,0) RESIDENTIAL ADDRESS COUNTY and RESIDENTIAL ADDRESS ZIP+4 fields. For a "IX",2,2,"AXRCTNRY",.1,6,0) domestic residential address, this cross reference will clear the "IX",2,2,"AXRCTNRY",.1,7,0) RESIDENTIAL PROVINCE and RESIDENTIAL POSTAL CODE fields. "IX",2,2,"AXRCTNRY",.1,8,0) See routine ^DGCNTRY for modifying which fields are cleared by this cross "IX",2,2,"AXRCTNRY",.1,9,0) reference. "IX",2,2,"AXRCTNRY",1) D EN^DGCNTRY(2,"RESI",.11573) "IX",2,2,"AXRCTNRY",2) Q "IX",2,2,"AXRCTNRY",11.1,0) ^.114IA^1^1 "IX",2,2,"AXRCTNRY",11.1,1,0) 1^F^2^.11573^^^F "IX",2,2,"AXRCTNRY",11.1,1,3) "IX",2,2.025,"AVAFC202501",0) 2.025^AVAFC202501^This x-ref calls the DG FIELD MONITOR event point.^MU^^F^I^I^2.025^^^^^A "IX",2,2.025,"AVAFC202501",.1,0) ^^5^5^3210628^ "IX",2,2.025,"AVAFC202501",.1,1,0) This cross-reference activates the DG FIELD MONITOR event point. "IX",2,2.025,"AVAFC202501",.1,2,0) Applications that wish to monitor edit activity related to this field may "IX",2,2.025,"AVAFC202501",.1,3,0) subscribe to that event point and take action as indicated by the changes "IX",2,2.025,"AVAFC202501",.1,4,0) that occur. Refer to the DG FIELD MONITOR protocol for a description of "IX",2,2.025,"AVAFC202501",.1,5,0) the information available at the time of the event. "IX",2,2.025,"AVAFC202501",1) D FC^DGFCPROT(.DA,2.025,.01,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2.025,"AVAFC202501",2) D FC^DGFCPROT(.DA,2.025,.01,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2.025,"AVAFC202501",11.1,0) ^.114IA^1^1 "IX",2,2.025,"AVAFC202501",11.1,1,0) 1^F^2.025^.01^^^F "IX",2,2.025,"AVAFC202501",11.1,1,3) "IX",2,2.2406,"AVAFC2240601",0) 2.2406^AVAFC2240601^This x-ref calls the DG FIELD MONITOR event point.^MU^^F^I^I^2.2406^^^^^A "IX",2,2.2406,"AVAFC2240601",.1,0) ^^5^5^3210628^ "IX",2,2.2406,"AVAFC2240601",.1,1,0) This cross-reference activates the DG FIELD MONITOR event point. "IX",2,2.2406,"AVAFC2240601",.1,2,0) Applications that wish to monitor edit activity related to this field may "IX",2,2.2406,"AVAFC2240601",.1,3,0) subscribe to that event point and take action as indicated by the changes "IX",2,2.2406,"AVAFC2240601",.1,4,0) that occur. Refer to the DG FIELD MONITOR protocol for a description of "IX",2,2.2406,"AVAFC2240601",.1,5,0) the information available at the time of the event. "IX",2,2.2406,"AVAFC2240601",1) D FC^DGFCPROT(.DA,2.2406,.01,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2.2406,"AVAFC2240601",2) D FC^DGFCPROT(.DA,2.2406,.01,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2.2406,"AVAFC2240601",11.1,0) ^.114IA^1^1 "IX",2,2.2406,"AVAFC2240601",11.1,1,0) 1^F^2.2406^.01^^^F "IX",2,2.2406,"AVAFC2240601",11.1,1,3) "MBREQ") 0 "PKG",5,-1) 1^1 "PKG",5,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "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) 1059^3211025^12700 "PKG",5,22,1,"PAH",1,1,0) ^^3^3^3211025 "PKG",5,22,1,"PAH",1,1,1,0) MASTER VETERAN INDEX VISTA ENHANCEMENT - NEW DEMOGRAPHIC FIELDS "PKG",5,22,1,"PAH",1,1,2,0) Refer to patch DG*5.3*1059 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") 10 "RTN","DGRPD") 0^4^B124542170^B113207988 "RTN","DGRPD",1,0) DGRPD ;ALB/MRL,MLR,JAN,LBD,EG,BRM,JRC,BAJ,JAM,HM,BDB,ARF,RN -PATIENT INQUIRY (NEW) ;July 09, 2014 12:16pm "RTN","DGRPD",2,0) ;;5.3;Registration;**109,124,121,57,161,149,286,358,436,445,489,498,506,513,518,550,545,568,585,677,703,688,887,907,925,936,940,941,987,1006,1056,1061,1059**;Aug 13, 1993;Build 6 "RTN","DGRPD",3,0) ; *286* Newing variables X,Y in OKLINE subroutine "RTN","DGRPD",4,0) ; *358* If a patient is on a domiciliary ward, don't display MEANS "RTN","DGRPD",5,0) ; TEST required/Medication Copayment Exemption messages "RTN","DGRPD",6,0) ; *436* If an inpatient is not on a domiciliary ward, don't display "RTN","DGRPD",7,0) ; Medication Copayment Exemption message "RTN","DGRPD",8,0) ; *545* Add death information near the remarks field "RTN","DGRPD",9,0) ; *677* Added Emergency Response "RTN","DGRPD",10,0) ; *688* Modified to display Country and Foreign Address "RTN","DGRPD",11,0) ; *936* Modified to display Health Benefit Plans "RTN","DGRPD",12,0) ; *940* #879316,#879318 - Display Permanent & Total Disabled Status "RTN","DGRPD",13,0) ; *941* #887088 - Redesign of Inquiry Screen layout for displaying the addresses "RTN","DGRPD",14,0) ; "RTN","DGRPD",15,0) ; Integration Agreements: "RTN","DGRPD",16,0) ; 6138 - DGHBPUTL API "RTN","DGRPD",17,0) ; "RTN","DGRPD",18,0) SEL K DFN,DGRPOUT W ! S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC G Q:Y'>0 S DFN=+Y N Y W ! S DIR(0)="E" D ^DIR G SEL:$D(DTOUT)!($D(DUOUT)) D EN G SEL "RTN","DGRPD",19,0) EN ;call to display patient inquiry - input DFN "RTN","DGRPD",20,0) ;MPI/PD CHANGE "RTN","DGRPD",21,0) S DGCMOR="UNSPECIFIED",DGMPI=$G(^DPT(+DFN,"MPI")) "RTN","DGRPD",22,0) K DGRPOUT,DGHOW S DGABBRV=$S($D(^DG(43,1,0)):+$P(^(0),"^",38),1:0),DGRPU="UNSPECIFIED" D DEM^VADPT,HDR^DGRPD1 "RTN","DGRPD",23,0) ;JAM begin changes Patch DG*5.3*941 add .115 and new address fields layout "RTN","DGRPD",24,0) F I=0,.11,.13,.121,.122,.31,.32,.36,.361,.141,.3,.115 S DGRP(I)=$S($D(^DPT(DFN,I)):^(I),1:"") "RTN","DGRPD",25,0) ;jam DG*5.3*925 RM#788099 change labels to "Permanent Mailing Address" and "Temporary Mailing Address" "RTN","DGRPD",26,0) ; "RTN","DGRPD",27,0) W " Residential Address: " "RTN","DGRPD",28,0) W ?40,"Mailing Address: " ;DG*5.3*1056 remove Permanent from the address label "RTN","DGRPD",29,0) S DGAD=.115,(DGA1,DGA2)=1 D AL^DGRPU(35) S DGAD=.11,DGA1=1,DGA2=2 D AL^DGRPU(35) "RTN","DGRPD",30,0) W !?5 "RTN","DGRPD",31,0) N Z,Z1 "RTN","DGRPD",32,0) S Z1=39,Z=$S($D(DGA(1)):DGA(1),1:"NONE ON FILE") D WW1^DGRPV W $S($D(DGA(2)):DGA(2),1:"NO PERMANENT MAILING ADDRESS") "RTN","DGRPD",33,0) ; loop through DGA array beginning with DGA(2) and print data at ?5 (odds) and ?44 (evens) "RTN","DGRPD",34,0) S I=2 F I1=0:0 S I=$O(DGA(I)) Q:I="" W:(I#2)!($X>40) !?5 W:'(I#2) ?44 W DGA(I) "RTN","DGRPD",35,0) N DGCC "RTN","DGRPD",36,0) S DGCC=$$COUNTY^DGRPCADD(.DGRP,.115) ; print County if applicable "RTN","DGRPD",37,0) W !?5,"County: "_DGCC "RTN","DGRPD",38,0) S DGCC=$$COUNTY^DGRPCADD(.DGRP,.11) ; print County if applicable "RTN","DGRPD",39,0) W ?44,"County: "_DGCC "RTN","DGRPD",40,0) W !?6,"Phone: ",$S($P(DGRP(.13),U,1)]"":$P(DGRP(.13),U,1),1:DGRPU) "RTN","DGRPD",41,0) W ?42,"Bad Addr: ",$$EXTERNAL^DILFD(2,.121,"",$P(DGRP(.11),U,16)) "RTN","DGRPD",42,0) W !?5,"Office: ",$S($P(DGRP(.13),U,2)]"":$P(DGRP(.13),U,2),1:DGRPU) "RTN","DGRPD",43,0) W ?46,"Cell: ",$S($P(DGRP(.13),U,4)]"":$P(DGRP(.13),U,4),1:DGRPU) "RTN","DGRPD",44,0) W !?44,"E-mail: ",$S($P(DGRP(.13),U,3)]"":$P(DGRP(.13),U,3),1:DGRPU) "RTN","DGRPD",45,0) W !! "RTN","DGRPD",46,0) K DGA,DGA1,DGA2 "RTN","DGRPD",47,0) I $P(DGRP(.121),"^",9)="Y" S DGAD=.121,(DGA1,DGA2)=1 D AL^DGRPU(30) "RTN","DGRPD",48,0) N CONACT "RTN","DGRPD",49,0) ; set Confidential Active Flag "RTN","DGRPD",50,0) S CONACT=$P(DGRP(.141),"^",9) "RTN","DGRPD",51,0) I CONACT="Y" D "RTN","DGRPD",52,0) .; check the begin/end dates, set active flag to NO and do not display if outside the date range "RTN","DGRPD",53,0) .N DGCABEG,DGCAEND,DGI "RTN","DGRPD",54,0) .S DGCABEG=$P(DGRP(.141),U,7),DGCAEND=$P(DGRP(.141),U,8) "RTN","DGRPD",55,0) .I 'DGCABEG!(DGCABEG>DT)!(DGCAEND&(DGCAEND40) !?5 W:'(I#2) ?44 W DGA(I) "RTN","DGRPD",63,0) W ! "RTN","DGRPD",64,0) I $D(DGA(1)) D "RTN","DGRPD",65,0) .S DGCC=$$COUNTY^DGRPCADD(.DGRP,.121) ; print County if applicable "RTN","DGRPD",66,0) .W ?5,"County: "_DGCC "RTN","DGRPD",67,0) I $D(DGA(2)) D "RTN","DGRPD",68,0) .S DGCC=$$COUNTY^DGRPCADD(.DGRP,.141) ; print County if applicable "RTN","DGRPD",69,0) .W ?44,"County: "_DGCC "RTN","DGRPD",70,0) ;W !?2,"CASS Cert: "_$S($P(DGRP(.121),U,15)="Y":"Certified",$P(DGRP(.121),U,15)="F":"Failed",1:"NC") "RTN","DGRPD",71,0) ;W ?41,"CASS Cert: "_$S($P(DGRP(.141),U,17)="Y":"Certified",$P(DGRP(.141),U,17)="F":"Failed",1:"NC") "RTN","DGRPD",72,0) W !?6,"Phone: ",$S($P(DGRP(.121),U,9)'="Y":"NOT APPLICABLE",$P(DGRP(.121),U,10)]"":$P(DGRP(.121),U,10),1:DGRPU) "RTN","DGRPD",73,0) W ?45,"Phone: ",$S($P(DGRP(.141),U,9)'="Y":"NOT APPLICABLE",CONACT'="Y":"NOT APPLICABLE",$P(DGRP(.13),U,15)]"":$P(DGRP(.13),U,15),1:DGRPU) "RTN","DGRPD",74,0) S X="NOT APPLICABLE" "RTN","DGRPD",75,0) I $P(DGRP(.121),U,9)="Y" D "RTN","DGRPD",76,0) .S Y=$P(DGRP(.121),U,7) X:Y]"" ^DD("DD") "RTN","DGRPD",77,0) .S X=$S(Y]"":Y,1:DGRPU)_"-",Y=$P(DGRP(.121),U,8) X:Y]"" ^DD("DD") "RTN","DGRPD",78,0) .S X=X_$S(Y]"":Y,1:DGRPU) "RTN","DGRPD",79,0) N DGACT,DGTYP,DGCAN,DGBEG,DGEND,DGZ,DGXX,DGX,DGTYPNAM,DGCAT "RTN","DGRPD",80,0) W !?2,"From/To: ",X "RTN","DGRPD",81,0) S DGX="NOT APPLICABLE" "RTN","DGRPD",82,0) I CONACT="Y" D "RTN","DGRPD",83,0) .S (DGZ,DGX)="" F DGI=7,8 S DGZ=$P(DGRP(.141),"^",DGI),Y=DGZ D "RTN","DGRPD",84,0) ..I DGI=7 X:Y]"" ^DD("DD") S DGBEG=Y,DGX=Y "RTN","DGRPD",85,0) ..I DGI=8 X:Y]"" ^DD("DD") S DGEND=Y,DGX=DGX_"-"_$S(Y]"":Y,1:"UNANSWERED") "RTN","DGRPD",86,0) W ?43,"From/To: "_DGX "RTN","DGRPD",87,0) W !?41,"Confidential Address Categories: " I $D(^DPT(DFN,.14)) D "RTN","DGRPD",88,0) .; If not active, do not display categories "RTN","DGRPD",89,0) .I CONACT'="Y" Q "RTN","DGRPD",90,0) .S DGCAT=$$GET1^DID(2.141,.01,"","POINTER","","DGERR") "RTN","DGRPD",91,0) .S DGX="",DGCAN="" F S DGCAN=$O(^DPT(DFN,.14,DGCAN)) Q:DGCAN="" D "RTN","DGRPD",92,0) ..Q:'$D(^DPT(DFN,.14,DGCAN,0)) "RTN","DGRPD",93,0) ..S DGTYP=$P(^DPT(DFN,.14,DGCAN,0),"^",1),DGACT=$P(^DPT(DFN,.14,DGCAN,0),"^",2) "RTN","DGRPD",94,0) ..S DGACT=$S(DGACT="Y":"Active",DGACT="N":"Inactive",1:"Unanswered") "RTN","DGRPD",95,0) ..S DGTYPNAM="" F DGI=1:1 S DGTYPNAM=$P(DGCAT,";",DGI) Q:DGTYPNAM="" D "RTN","DGRPD",96,0) ...I DGTYPNAM[DGTYP S DGTYPNAM=$P(DGTYPNAM,":",2),DGX=DGTYPNAM_"("_DGACT_")"_","_DGX "RTN","DGRPD",97,0) S DGXX="" F DGI=1:1 S DGXX=$P(DGX,",",DGI) Q:DGXX="" D "RTN","DGRPD",98,0) .W !?42,DGXX "RTN","DGRPD",99,0) ; "RTN","DGRPD",100,0) I '$$OKLINE^DGRPD1(16) G Q "RTN","DGRPD",101,0) N DGEMER S DGEMER=$$EXTERNAL^DILFD(2,.181,"",$P($G(^DPT(DFN,.18)),"^")) "RTN","DGRPD",102,0) W:DGEMER]"" !?32,"Emergency Response: ",DGEMER "RTN","DGRPD",103,0) I 'DGABBRV W !!?4,"POS: ",$S($D(^DIC(21,+$P(DGRP(.32),"^",3),0)):$P(^(0),"^",1),1:DGRPU),?42,"Claim #: ",$S($P(DGRP(.31),"^",3)]"":$P(DGRP(.31),"^",3),1:"UNSPECIFIED") "RTN","DGRPD",104,0) I 'DGABBRV W !?2,"Relig: ",$S($D(^DIC(13,+$P(DGRP(0),"^",8),0)):$P(^(0),"^",1),1:DGRPU),?46 ;,"Birth Sex: ",$S($P(VADM(5),"^",2)]"":$P(VADM(5),"^",2),1:"UNSPECIFIED") ; DG*5.3*907 "RTN","DGRPD",105,0) ;**159 REMOVE CONDITIONAL DISPLAY OF BIRTH SEX AND GROUP WITH OTHER SOGI FIELDS "RTN","DGRPD",106,0) I 'DGABBRV W ! D "RTN","DGRPD",107,0) .N RACE,ETHNIC,PTR,VAL,X,DIWL,DIWR,DIWF "RTN","DGRPD",108,0) .K ^UTILITY($J,"W") "RTN","DGRPD",109,0) .S PTR=0 F S PTR=+$O(^DPT(DFN,.02,PTR)) Q:'PTR D "RTN","DGRPD",110,0) ..S VAL=+$G(^DPT(DFN,.02,PTR,0)) "RTN","DGRPD",111,0) ..Q:$$INACTIVE^DGUTL4(VAL,1) "RTN","DGRPD",112,0) ..S VAL=$$PTR2TEXT^DGUTL4(VAL,1) S:+$O(^DPT(DFN,.02,PTR)) VAL=VAL_", " "RTN","DGRPD",113,0) ..S X=VAL,DIWL=0,DIWR=30,DIWF="" D ^DIWP "RTN","DGRPD",114,0) .M RACE=^UTILITY($J,"W",0) S:$G(RACE(1,0))="" RACE(1,0)="UNANSWERED" "RTN","DGRPD",115,0) .K ^UTILITY($J,"W") "RTN","DGRPD",116,0) .S PTR=0 F S PTR=+$O(^DPT(DFN,.06,PTR)) Q:'PTR D "RTN","DGRPD",117,0) ..S VAL=+$G(^DPT(DFN,.06,PTR,0)) "RTN","DGRPD",118,0) ..Q:$$INACTIVE^DGUTL4(VAL,2) "RTN","DGRPD",119,0) ..S VAL=$$PTR2TEXT^DGUTL4(VAL,2) S:+$O(^DPT(DFN,.06,PTR)) VAL=VAL_", " "RTN","DGRPD",120,0) ..S X=VAL,DIWL=0,DIWR=30,DIWF="" D ^DIWP "RTN","DGRPD",121,0) .M ETHNIC=^UTILITY($J,"W",0) S:$G(ETHNIC(1,0))="" ETHNIC(1,0)="UNANSWERED" "RTN","DGRPD",122,0) .K ^UTILITY($J,"W") "RTN","DGRPD",123,0) .W ?3,"Race: ",RACE(1,0),?40,"Ethnicity: ",ETHNIC(1,0) "RTN","DGRPD",124,0) .F X=2:1 Q:'$D(RACE(X,0))&'$D(ETHNIC(X,0)) W !,?9,$G(RACE(X,0)),?51,$G(ETHNIC(X,0)) "RTN","DGRPD",125,0) I '$$OKLINE^DGRPD1(16) G Q "RTN","DGRPD",126,0) ;**1059 ADDING SOGI fields including BIRTH SEX "RTN","DGRPD",127,0) D SOGI "RTN","DGRPD",128,0) D LANGUAGE "RTN","DGRPD",129,0) I '$$OKLINE^DGRPD1(10) G Q "RTN","DGRPD",130,0) ;display cv status #4156 "RTN","DGRPD",131,0) N DGCV S DGCV=$$CVEDT^DGCV(+DFN) "RTN","DGRPD",132,0) W !!,?2,"Combat Vet Status: "_$S($P(DGCV,U,3)=1:"ELIGIBLE",$P(DGCV,U,3)="":"NOT ELIGIBLE",1:"EXPIRED") I DGCV>0 W ?45,"End Date: "_$$FMTE^XLFDT($P(DGCV,U,2),"5DZ") "RTN","DGRPD",133,0) ;DG*5.3*1061 Display COMPACT ACT status only if TRUE "RTN","DGRPD",134,0) N DGCOMPACT S DGCOMPACT=$$CAI^DGENELA(+DFN) "RTN","DGRPD",135,0) I DGCOMPACT=1 W !,?1,"COMPACT Act Status: ELIGIBLE" "RTN","DGRPD",136,0) ; "RTN","DGRPD",137,0) ;display primary eligibility "RTN","DGRPD",138,0) S X1=DGRP(.36),X=$P(DGRP(.361),"^",1) W !,"Primary Eligibility: ",$S($D(^DIC(8,+X1,0)):$P(^(0),"^",1)_" ("_$S(X="V":"VERIFIED",X="P":"PENDING VERIFICATION",X="R":"PENDING REVERIFICATION",1:"NOT VERIFIED")_")",1:DGRPU) "RTN","DGRPD",139,0) W !,"Other Eligibilities: " F I=0:0 S I=$O(^DIC(8,I)) Q:'I I $D(^DIC(8,I,0)),I'=+X1 S X=$P(^(0),"^",1)_", " I $D(^DPT("AEL",DFN,I)) W:$X+$L(X)>79 !?21 W X "RTN","DGRPD",140,0) I '$$OKLINE^DGRPD1(16) G Q "RTN","DGRPD",141,0) ;employability status "RTN","DGRPD",142,0) W !?6,"Unemployable: ",$S($P(DGRP(.3),U,5)="Y":"YES",1:"NO") "RTN","DGRPD",143,0) I '$$OKLINE^DGRPD1(19) G Q "RTN","DGRPD",144,0) ; KUM DG*5.3*940 RM #879316,#879318 - Display Permanent & Total Disabled status "RTN","DGRPD",145,0) W !?6,"Permanent & Total Disabled: ",$S($P(DGRP(.3),U,4)="Y":"YES",1:"NO") "RTN","DGRPD",146,0) I '$$OKLINE^DGRPD1(19) G Q "RTN","DGRPD",147,0) ;display the catastrophic disability review date if there is one "RTN","DGRPD",148,0) D CATDIS^DGRPD1 "RTN","DGRPD",149,0) I $G(DGPRFLG)=1 G Q:'$$OKLINE^DGRPD1(19) D "RTN","DGRPD",150,0) . N DGPDT,DGPTM "RTN","DGRPD",151,0) . W !,$$REPEAT^XLFSTR("-",78) "RTN","DGRPD",152,0) . S DGPDT="",DGPDT=$O(^DGS(41.41,"ADC",DFN,DGPDT),-1) "RTN","DGRPD",153,0) . W !,"[PRE-REGISTER DATE:] "_$S(DGPDT]"":$$FMTE^XLFDT(DGPDT,"1D"),1:"NONE ON FILE") "RTN","DGRPD",154,0) . S DGPTM=$$PCTEAM^DGSDUTL(DFN) "RTN","DGRPD",155,0) . I $P(DGPTM,U,2)]"" W !,"[PRIMARY CARE TEAM:] "_$P(DGPTM,U,2) "RTN","DGRPD",156,0) . W !,$$REPEAT^XLFSTR("-",78) "RTN","DGRPD",157,0) ; Check if patient is an inpatient and on a DOM ward "RTN","DGRPD",158,0) ; If inpatient is on a DOM ward, don't display MT or CP messages "RTN","DGRPD",159,0) ; If inpatient is NOT on a DOM ward, don't display CP message "RTN","DGRPD",160,0) N DGDOM,DGDOM1,VAHOW,VAROOT,VAINDT,VAIP,VAERR "RTN","DGRPD",161,0) G Q:'$$OKLINE^DGRPD1(16) "RTN","DGRPD",162,0) D DOM^DGMTR "RTN","DGRPD",163,0) I '$G(DGDOM) D "RTN","DGRPD",164,0) .D DIS^DGMTU(DFN) "RTN","DGRPD",165,0) .D IN5^VADPT "RTN","DGRPD",166,0) .I $G(VAIP(1))="" D DISP^IBARXEU(DFN,DT,3,1) "RTN","DGRPD",167,0) ;I 'DGABBRV,$E(IOST,1,2)="C-" F I=$Y:1:20 W ! "RTN","DGRPD",168,0) D DIS^EASECU(DFN) ;Added for LTC III (DG*5.3*518) "RTN","DGRPD",169,0) S VAIP("L")="" "RTN","DGRPD",170,0) I $$OKLINE^DGRPD1(14) D INP "RTN","DGRPD",171,0) I '$G(DGRPOUT),($$OKLINE^DGRPD1(10)) D SA ;*KNR* "RTN","DGRPD",172,0) ;MPI/PD CHANGE "RTN","DGRPD",173,0) Q D KVA^VADPT K %DT,D0,D1,DGA,DGA1,DGA2,DGABBRV,DGAD,DGCC,DGCMOR,DGDOM,DGLOCATN,DGMPI,DGRP,DGRPU,DGS,DGST,DGXFR0,DIC,DIR,DTOUT,DUOUT,DIRUT,DIROUT,I,I1,L,LDM,POP,SDCT,VA,X,X1,Y Q "RTN","DGRPD",174,0) ; "RTN","DGRPD",175,0) INP S VAIP("D")="L" D INP^DGPMV10 "RTN","DGRPD",176,0) S DGPMT=0 "RTN","DGRPD",177,0) D CS^DGPMV10 K DGPMT,DGPMIFN K:'$D(DGSWITCH) DGPMVI,DGPMDCD Q "RTN","DGRPD",178,0) SA F I=0:0 S I=$O(^DGS(41.1,"B",DFN,I)) G CL:'I S X=^DGS(41.1,I,0) I $P(X,"^",2)>(DT-1),$P(X,"^",13)']"",'$P(X,"^",17) S L=$P(X,"^",2) D:$$OKLINE^DGRPD1(17) SAA Q:$G(DGRPOUT) "RTN","DGRPD",179,0) Q "RTN","DGRPD",180,0) SAA ;Scheduled Admit Data "RTN","DGRPD",181,0) W !!?14,"Scheduled Admit" "RTN","DGRPD",182,0) W:$D(^DIC(42,+$P(X,U,8),0)) " on ward "_$P(^(0),U) "RTN","DGRPD",183,0) W:$D(^DIC(45.7,+$P(X,U,9),0)) " for treating specialty "_$P(^(0),U) "RTN","DGRPD",184,0) W " on "_$$FMTE^XLFDT(L,"5DZ") "RTN","DGRPD",185,0) Q ;SAA "RTN","DGRPD",186,0) ; "RTN","DGRPD",187,0) CL G FA:$O(^DPT(DFN,"DE",0))="" S SDCT=0 F I=0:0 S I=$O(^DPT(DFN,"DE",I)) Q:'I I $D(^(I,0)),$P(^(0),"^",2)'="I",$O(^(0)) S SDCT=SDCT+1 W:SDCT=1 !!,"Currently enrolled in " W:$X>50 !?22 W $S($D(^SC(+^(0),0)):$P(^(0),"^",1)_", ",1:"") "RTN","DGRPD",188,0) ; "RTN","DGRPD",189,0) FA ; "RTN","DGRPD",190,0) N DGARRAY,SDCNT "RTN","DGRPD",191,0) S DGARRAY("FLDS")="1;2;3;18",DGARRAY(4)=DFN,DGARRAY(1)=DT,DGARRAY("SORT")="P" "RTN","DGRPD",192,0) S SDCNT=$$SDAPI^SDAMA301(.DGARRAY),CT=0 W !!,"Future Appointments: " "RTN","DGRPD",193,0) ;if there is lower subscripts hanging from the 101 node, "RTN","DGRPD",194,0) ;then it is a valid appointment, otherwise it is "RTN","DGRPD",195,0) ;an error eg 01/20/2005 "RTN","DGRPD",196,0) ;G:'$$OKLINE^DGRPD1(13) RMK ;*///* "RTN","DGRPD",197,0) I $D(^TMP($J,"SDAMA301",101))=1 W "Appointment Database is Unavailable" G RMK "RTN","DGRPD",198,0) I $O(^TMP($J,"SDAMA301",DFN,DT))'>0 W "NONE" G RMK "RTN","DGRPD",199,0) ; "RTN","DGRPD",200,0) W ?22,"Date",?33,"Time",?39,"Clinic",!?22 F I=22:1:75 W "=" "RTN","DGRPD",201,0) F FA=DT:0 S FA=$O(^TMP($J,"SDAMA301",DFN,FA)) G RMK:'FA D Q:CT>5 "RTN","DGRPD",202,0) .N STAT S STAT=$P($P(^TMP($J,"SDAMA301",DFN,FA),U,3),";") "RTN","DGRPD",203,0) .S C=+$P(^TMP($J,"SDAMA301",DFN,FA),U,2) I STAT'["C" D "RTN","DGRPD",204,0) ..D COV "RTN","DGRPD",205,0) ..N DGAPPT S DGAPPT=$$FMTE^XLFDT($E(FA,1,12),"5Z") "RTN","DGRPD",206,0) ..W !?22,$P(DGAPPT,"@"),?33,$P(DGAPPT,"@",2) "RTN","DGRPD",207,0) ..W ?39,$P($P(^TMP($J,"SDAMA301",DFN,FA),U,2),";",2)," ",COV "RTN","DGRPD",208,0) ..Q "RTN","DGRPD",209,0) I $O(^TMP($J,"SDAMA301",DFN,FA))>0 W !,"See Scheduling options for additional appointments." "RTN","DGRPD",210,0) RMK I '$G(DGRPOUT),($$OKLINE^DGRPD1(15)) W !!,"Remarks: ",$P(^DPT(DFN,0),"^",10) ;*///* "RTN","DGRPD",211,0) D GETS^DIQ(2,DFN_",",".351;.353;.354;.355","E","PDTHINFO") "RTN","DGRPD",212,0) W !! "RTN","DGRPD",213,0) W "Date of Death Information" "RTN","DGRPD",214,0) W !,?5,"Date of Death: ",$G(PDTHINFO(2,DFN_",",.351,"E")) "RTN","DGRPD",215,0) W !,?5,"Source of Notification: ",$G(PDTHINFO(2,DFN_",",.353,"E")) "RTN","DGRPD",216,0) W !,?5,"Updated Date/Time: ",$G(PDTHINFO(2,DFN_",",.354,"E")) "RTN","DGRPD",217,0) W !,?5,"Last Edited By: ",$G(PDTHINFO(2,DFN_",",.355,"E")),! "RTN","DGRPD",218,0) I $$OKLINE^DGRPD1(14) D EC^DGRPD1 "RTN","DGRPD",219,0) ; KUM DG*5.3*936 Call tag to display Health Benefit Plans assigned to Veteran "RTN","DGRPD",220,0) D HBP "RTN","DGRPD",221,0) K DGARRAY,SDCNT,^TMP($J,"SDAMA301"),ADM,L,TRN,DIS,SSN,FA,C,COV,NOW,CT,DGD,DGD1,I ;Y killed after dghinqky "RTN","DGRPD",222,0) Q "RTN","DGRPD",223,0) ; KUM DG*5.3*936 Display Health Benefit Plans assigned to Veteran "RTN","DGRPD",224,0) HBP ;W !!,"Veteran Medical Benefit Plan Currently Assigned to Veteran:" ;DG*5.3*987 HM "RTN","DGRPD",225,0) W !!,"VHA Profiles Currently Assigned to Veteran:" ;DG*5.3*1006 BDB;DG*5.3*987 HM "RTN","DGRPD",226,0) N DGHBP,HBP,DGCOUNT,DGHBIEN,DGPNAME,X,DGCNT,DGLN,DGLINE "RTN","DGRPD",227,0) S DGCOUNT=0 "RTN","DGRPD",228,0) D GETHBP^DGHBPUTL(DFN) "RTN","DGRPD",229,0) S DGHBP="" F S DGHBP=$O(HBP("CUR",DGHBP)) Q:DGHBP="" D "RTN","DGRPD",230,0) .; DG*5.3*987; jam; Place "zz" before the plan name for inactive plans "RTN","DGRPD",231,0) .S DGHBIEN=+HBP("CUR",DGHBP) "RTN","DGRPD",232,0) .I $P($G(^DGHBP(25.11,DGHBIEN,0)),"^",4)="Y" S DGPNAME="zz "_DGHBP "RTN","DGRPD",233,0) .E S DGPNAME=DGHBP "RTN","DGRPD",234,0) .; DG*5.3*987; arf; Add word wrapping for plan names "RTN","DGRPD",235,0) .S X=DGPNAME "RTN","DGRPD",236,0) .K ^UTILITY($J,"W") S DIWL=0,DIWR=70,DIWF="" D ^DIWP "RTN","DGRPD",237,0) .S DGCNT=^UTILITY($J,"W",0) "RTN","DGRPD",238,0) .F DGLN=1:1:DGCNT S DGLINE=^UTILITY($J,"W",0,DGLN,0) W !,?3,DGLINE "RTN","DGRPD",239,0) .K ^UTILITY($J,"W") "RTN","DGRPD",240,0) .S DGCOUNT=DGCOUNT+1 "RTN","DGRPD",241,0) I DGCOUNT=0 W !,?3,"None" "RTN","DGRPD",242,0) Q "RTN","DGRPD",243,0) ; "RTN","DGRPD",244,0) COV S COV=$S(+$P(^TMP($J,"SDAMA301",DFN,FA),U,18)=7:" (Collateral) ",1:"") "RTN","DGRPD",245,0) S COV=COV_$S(STAT["NT":" * NO ACTION TAKEN *",STAT["N":" * NO-SHOW *",1:""),CT=CT+1 Q "RTN","DGRPD",246,0) Q "RTN","DGRPD",247,0) ; "RTN","DGRPD",248,0) OREN S XQORQUIT=1 Q:'$D(ORVP) S DFN=+ORVP D EN R !!,"Press RETURN to CONTINUE: ",X:DTIME "RTN","DGRPD",249,0) Q "RTN","DGRPD",250,0) LANGUAGE ; Get language data *///* "RTN","DGRPD",251,0) S DGLANGDT=9999999,(DGPRFLAN,DGLANG0)="" "RTN","DGRPD",252,0) S DGLANGDT=$O(^DPT(DFN,.207,"B",DGLANGDT),-1) "RTN","DGRPD",253,0) I DGLANGDT="" G L1 "RTN","DGRPD",254,0) S DGLANGDA=$O(^DPT(DFN,.207,"B",DGLANGDT,0)) "RTN","DGRPD",255,0) S DGLANG0=$G(^DPT(DFN,.207,DGLANGDA,0)),Y=$P(DGLANG0,U),DGPRFLAN=$P(DGLANG0,U,2) "RTN","DGRPD",256,0) S Y=DGLANGDT X ^DD("DD") S DGLANGDT=Y "RTN","DGRPD",257,0) L1 W !!,"Language Date/Time: ",$S(DGLANGDT="":"UNANSWERED",1:DGLANGDT),! "RTN","DGRPD",258,0) W ?1,"Preferred Language: ",$S(DGPRFLAN="":"UNANSWERED",1:DGPRFLAN) "RTN","DGRPD",259,0) K DGLANGDT,DGPRFLAN,DGLANG0,DGLANGDA "RTN","DGRPD",260,0) Q "RTN","DGRPD",261,0) SOGI ;**1059 SOGI FIELDS TO BE DISPLAYED VAMPI-11114,VAMPI-11118,VAMPI-11120, VAMPI-11121 "RTN","DGRPD",262,0) N EN,SXO,PRN "RTN","DGRPD",263,0) W !,"Birth Sex : ",$$GET1^DIQ(2,DFN,".02","E") "RTN","DGRPD",264,0) ;SEXUAL ORIENTATION "RTN","DGRPD",265,0) W !,"Sexual Orientation: ",! "RTN","DGRPD",266,0) S EN=0 F S EN=$O(^DPT(DFN,.025,EN)) Q:'EN D "RTN","DGRPD",267,0) .S SXO=$G(^DPT(DFN,.025,EN,0)) "RTN","DGRPD",268,0) .W ?20,$P($G(^DG(47.77,SXO,0)),"^"),! "RTN","DGRPD",269,0) W !,"Sexual Orientation Description: ",$$GET1^DIQ(2,DFN,".0251","E") "RTN","DGRPD",270,0) W !,"Pronoun: ",! "RTN","DGRPD",271,0) S EN=0 F S EN=$O(^DPT(DFN,.2406,EN)) Q:'EN D "RTN","DGRPD",272,0) .S PRN=$G(^DPT(DFN,.2406,EN,0)) "RTN","DGRPD",273,0) .W ?20,$P($G(^DG(47.78,PRN,0)),"^"),! "RTN","DGRPD",274,0) W !,"Pronoun Description: ",$$GET1^DIQ(2,DFN,".24061","E") "RTN","DGRPD",275,0) W !,"Self-Identified Gender Identity: ",$$GET1^DIQ(2,DFN,".024","E") "RTN","DGRPD",276,0) Q "RTN","VADPT0") 0^2^B15146379^B15089633 "RTN","VADPT0",1,0) VADPT0 ;ALB/MRL/MJK,ERC,TDM,ARF - PATIENT VARIABLE ROUTINE DRIVER, CONT. ;02/22/2016 "RTN","VADPT0",2,0) ;;5.3;Registration;**343,342,415,489,498,528,689,789,688,759,754,887,952,996,1059**;Aug 13, 1993;Build 6 "RTN","VADPT0",3,0) ; "RTN","VADPT0",4,0) ;Initialize variables "RTN","VADPT0",5,0) N I1 "RTN","VADPT0",6,0) S U="^" D DT^DICRW:'$D(DT) "RTN","VADPT0",7,0) S VAERR=$S($G(DFN)="":1,'$D(^DPT(DFN,0)):1,1:0) "RTN","VADPT0",8,0) S Y=VAN'=13 I Y,$D(VAROOT)'[0,VAROOT]"" S Y=0,VAV=VAROOT K @VAV "RTN","VADPT0",9,0) I Y S:$S(VAN>9:1,'$D(VAHOW):0,1:VAHOW[2) VAV="^UTILITY("_""""_VAV_""""_","_$J_")" "RTN","VADPT0",10,0) D @VAN "RTN","VADPT0",11,0) Q K X,Y,VAC,VAS,VAV,VAW,VAN,I,VAX,VAZ Q "RTN","VADPT0",12,0) ; "RTN","VADPT0",13,0) INIT ; -- determine #'s or names then init array "RTN","VADPT0",14,0) ; "RTN","VADPT0",15,0) S VAS="1^2^3^4^5^6^7^8^9^10^11^12^13^14^15^16^17^18^19^20^21^22^23^24^25^26^27^28^29" "RTN","VADPT0",16,0) I VAN<10,$D(VAHOW),VAHOW[1 S VAS=$P($T(SS+VAN),";;",2) "RTN","VADPT0",17,0) I $D(VAN(1)) F I=1:1:VAN(1) S @VAV@($P(VAS,"^",I))="" "RTN","VADPT0",18,0) Q "RTN","VADPT0",19,0) ; "RTN","VADPT0",20,0) 1 ; -- [DEM] demos "RTN","VADPT0",21,0) D C1,INIT I 'VAERR D 1^VADPT1,13 Q "RTN","VADPT0",22,0) ; "RTN","VADPT0",23,0) 01 ; -- [DEMUPD] demos with PREFERRED NAME added - DG*5.3*996 "RTN","VADPT0",24,0) D C01,INIT S @VAV@($P(VAS,"^",1),1)="" I 'VAERR D 1^VADPT1 S @VAV@($P(VAS,"^",1),1)=$$GET1^DIQ(2,+DFN_",",.2405,"E") D 13 Q "RTN","VADPT0",25,0) ; "RTN","VADPT0",26,0) 2 ; -- [OPD] other pt vars "RTN","VADPT0",27,0) D C2,INIT,2^VADPT1:'VAERR Q "RTN","VADPT0",28,0) ; "RTN","VADPT0",29,0) 3 ; -- [ADD] current address "RTN","VADPT0",30,0) D C3,INIT,3^VADPT1:'VAERR Q "RTN","VADPT0",31,0) ; "RTN","VADPT0",32,0) 4 ; -- [OAD] other pt vars "RTN","VADPT0",33,0) D C4,INIT,4^VADPT1:'VAERR Q "RTN","VADPT0",34,0) ; "RTN","VADPT0",35,0) 5 ; -- [INP] inpt data -v5 "RTN","VADPT0",36,0) D C5,INIT,5^VADPT2:'VAERR Q "RTN","VADPT0",37,0) ; "RTN","VADPT0",38,0) 6 ; -- [IN5] inpt data v5 "RTN","VADPT0",39,0) D C6,INIT F I=13:1:17 F I1=1:1:7 S @VAV@($P(VAS,"^",I),I1)="" "RTN","VADPT0",40,0) F I=1:1:3 S @VAV@($P(VAS,"^",19),I)="" "RTN","VADPT0",41,0) D 6^VADPT3:'VAERR Q "RTN","VADPT0",42,0) ; "RTN","VADPT0",43,0) 7 ; -- [ELIG] elig data "RTN","VADPT0",44,0) D C7,INIT F I=1:1:6 S @VAV@($P(VAS,"^",5),I)="" "RTN","VADPT0",45,0) D 7^VADPT4:'VAERR Q "RTN","VADPT0",46,0) ; "RTN","VADPT0",47,0) 8 ; -- [MB] $ benefits "RTN","VADPT0",48,0) D C8,INIT D 8^VADPT4:'VAERR Q "RTN","VADPT0",49,0) ; "RTN","VADPT0",50,0) 9 ; -- [SVC] service data "RTN","VADPT0",51,0) D C9,INIT F I=1:1:9 S @VAV@($P(VAS,"^",I),1)="",@VAV@($P(VAS,"^",I),2)="" "RTN","VADPT0",52,0) S @VAV@($P(VAS,"^",10),1)="" "RTN","VADPT0",53,0) F I=11:1:13 S @VAV@($P(VAS,"^",I))=0 "RTN","VADPT0",54,0) S @VAV@($P(VAS,"^",14),1)="" "RTN","VADPT0",55,0) S @VAV@($P(VAS,"^",4),3)="",@VAV@($P(VAS,"^",5),3)="" "RTN","VADPT0",56,0) F I=2,6,7,8 F I1=3,4,5 S @VAV@($P(VAS,"^",I),I1)="" "RTN","VADPT0",57,0) D 9^VADPT4:'VAERR Q "RTN","VADPT0",58,0) ; "RTN","VADPT0",59,0) 10 ; -- [REG] registration data "RTN","VADPT0",60,0) D C10,INIT D 10^VADPT5:'VAERR Q "RTN","VADPT0",61,0) ; "RTN","VADPT0",62,0) 11 ; -- [SDE] clinic enrollment data "RTN","VADPT0",63,0) D C11,INIT D 11^VADPT5:'VAERR Q "RTN","VADPT0",64,0) ; "RTN","VADPT0",65,0) 12 ; -- [SDA] appt data "RTN","VADPT0",66,0) D C12,INIT D 12^VADPT5:'VAERR Q "RTN","VADPT0",67,0) ; "RTN","VADPT0",68,0) 13 ; -- [PID] pt id's "RTN","VADPT0",69,0) S (VA("PID"),VA("BID"))="" D 13^VADPT6:'VAERR Q "RTN","VADPT0",70,0) ; "RTN","VADPT0",71,0) KVAR ; kill all vadpt data "RTN","VADPT0",72,0) K VAN "RTN","VADPT0",73,0) C1 K ^UTILITY("VADM",$J),VADM Q:$D(VAN) "RTN","VADPT0",74,0) C01 K ^UTILITY("VADEMO",$J),VADEMO Q:$D(VAN) ;DG*5.3*996 "RTN","VADPT0",75,0) C2 K ^UTILITY("VAPD",$J),VAPD Q:$D(VAN) "RTN","VADPT0",76,0) C3 K X S:$D(VAPA("P")) X("P")=VAPA("P") "RTN","VADPT0",77,0) S:$D(VAPA("CD")) X("CD")=VAPA("CD") "RTN","VADPT0",78,0) K ^UTILITY("VAPA",$J),VAPA "RTN","VADPT0",79,0) S:$D(X("P")) VAPA("P")=X("P") K X("P") "RTN","VADPT0",80,0) S:$D(X("CD")) VAPA("CD")=X("CD") K X Q:$D(VAN) "RTN","VADPT0",81,0) C4 K X S:$D(VAOA("A")) X("A")=VAOA("A") "RTN","VADPT0",82,0) K ^UTILITY("VAOA",$J),VAOA "RTN","VADPT0",83,0) S:$D(X("A")) VAOA("A")=X("A") K X Q:$D(VAN) "RTN","VADPT0",84,0) C5 K ^UTILITY("VAIN",$J),VAIN Q:$D(VAN) "RTN","VADPT0",85,0) C6 K X F I="D","E","L","M","V" I $D(VAIP(I)) S X(I)=VAIP(I) "RTN","VADPT0",86,0) S Y=$S('$D(VAIP("V")):"VAIP",VAIP("V")'?1A.E:"VAIP",1:VAIP("V")) K ^UTILITY(Y,$J),@Y "RTN","VADPT0",87,0) F I="D","E","L","M","V" I $D(X(I)) S VAIP(I)=X(I) "RTN","VADPT0",88,0) K X Q:$D(VAN) "RTN","VADPT0",89,0) C7 K ^UTILITY("VAEL",$J),VAEL Q:$D(VAN) "RTN","VADPT0",90,0) C8 K ^UTILITY("VAMB",$J),VAMB Q:$D(VAN) "RTN","VADPT0",91,0) C9 K ^UTILITY("VASV",$J),VASV Q:$D(VAN) "RTN","VADPT0",92,0) C10 K ^UTILITY("VARP",$J) Q:$D(VAN) "RTN","VADPT0",93,0) C11 K ^UTILITY("VAEN",$J) Q:$D(VAN) "RTN","VADPT0",94,0) C12 K ^UTILITY("VASD",$J) Q "RTN","VADPT0",95,0) C13 Q "RTN","VADPT0",96,0) ; "RTN","VADPT0",97,0) SS ; 1^ 2^ 3^ 4^ 5^ 6^ 7^ 8^ 9^10^11^12^13^14^15^16^17^18^19^20^21^22^23^24^25^26^27^28 "RTN","VADPT0",98,0) ;;NM^SS^DB^AG^SX^EX^RE^RA^RP^MS^ET^RC^PL^SOGI "RTN","VADPT0",99,0) ;;BC^BS^FN^MN^MM^OC^ES^WP "RTN","VADPT0",100,0) ;;L1^L2^L3^CI^ST^ZP^CO^PN^TS^TE^Z4^CCA^CL1^CL2^CL3^CCI^CST^CZP^CCO^CCS^CCE^CTY^PR^PC^CT^CPR^CPC^CCT^CPN "RTN","VADPT0",101,0) ;;L1^L2^L3^CI^ST^ZP^CO^PN^NM^RE^Z4 "RTN","VADPT0",102,0) ;;AN^DR^TS^WL^RB^BS^AD^AT^AF^PT^AP "RTN","VADPT0",103,0) ;;MN^TT^MD^MT^WL^RB^DR^TS^MF^BS^RD^PT^AN^LN^PN^NN^DN^AP^FD "RTN","VADPT0",104,0) ;;EL^PS^SC^VT^IN^TY^CN^ES^MT^OTH "RTN","VADPT0",105,0) ;;AA^HB^SS^PE^MR^SI^DI^OR^GI "RTN","VADPT0",106,0) ;;VN^AO^IR^PW^CS^S1^S2^S3^PH^CV^OIF^OEF^UNK^SHD "RTN","VADPT1") 0^1^B68594806^B57593585 "RTN","VADPT1",1,0) VADPT1 ;ALB/MRL,MJK,ERC,TDM,CLT - PATIENT VARIABLES ;05 May 2017 1:41 PM "RTN","VADPT1",2,0) ;;5.3;Registration;**415,489,516,614,688,754,887,941,1059**;Aug 13, 1993;Build 6 "RTN","VADPT1",3,0) ; "RTN","VADPT1",4,0) 1 ;Demographic [DEM] "RTN","VADPT1",5,0) N W,Z,NODE "RTN","VADPT1",6,0) ; "RTN","VADPT1",7,0) ; -- name [1 - NM] "RTN","VADPT1",8,0) S VAX=^DPT(DFN,0),@VAV@($P(VAS,"^",1))=$P(VAX,"^") "RTN","VADPT1",9,0) ; "RTN","VADPT1",10,0) ; -- ssn [2 - SS] "RTN","VADPT1",11,0) S Z=$P(VAX,"^",9) S:Z]"" @VAV@($P(VAS,"^",2))=Z_$S(Z]"":"^"_$E(Z,1,3)_"-"_$E(Z,4,5)_"-"_$E(Z,6,10),1:"") "RTN","VADPT1",12,0) ; "RTN","VADPT1",13,0) ; -- date of birth [2 - DB] "RTN","VADPT1",14,0) S Z=$P(VAX,"^",3),Y=Z I Y]"" X ^DD("DD") S @VAV@($P(VAS,"^",3))=Z_"^"_Y "RTN","VADPT1",15,0) ; "RTN","VADPT1",16,0) ; -- age [4 - AG] "RTN","VADPT1",17,0) S W=$S('$D(^DPT(DFN,.35)):"",'^(.35):"",1:+^(.35)) S Y=$S('W:DT,1:W) S:Z]"" @VAV@($P(VAS,"^",4))=$E(Y,1,3)-$E(Z,1,3)-($E(Y,4,7)<$E(Z,4,7)) "RTN","VADPT1",18,0) ; "RTN","VADPT1",19,0) ; -- expired date [6 - EX] "RTN","VADPT1",20,0) S (Y,Z)=W X:Y]"" ^DD("DD") S:Z]"" @VAV@($P(VAS,"^",6))=Z_"^"_Y "RTN","VADPT1",21,0) ; "RTN","VADPT1",22,0) ; -- sex [5 - SX] "RTN","VADPT1",23,0) S Z=$P(VAX,"^",2) S:Z]"" @VAV@($P(VAS,"^",5))=Z_"^"_$S(Z="M":"MALE",Z="F":"FEMALE",1:"") K Z "RTN","VADPT1",24,0) ; "RTN","VADPT1",25,0) ; -- remarks [7 - RE] "RTN","VADPT1",26,0) S @VAV@($P(VAS,"^",7))=$P(VAX,"^",10) "RTN","VADPT1",27,0) ; "RTN","VADPT1",28,0) ; -- historic race [8 - RA] "RTN","VADPT1",29,0) S Z=$P(VAX,"^",6),@VAV@($P(VAS,"^",8))=Z_$S($D(^DIC(10,+Z,0)):"^"_$P(^(0),"^"),1:"") "RTN","VADPT1",30,0) ; "RTN","VADPT1",31,0) ; -- religion [9 - RP] "RTN","VADPT1",32,0) S Z=$P(VAX,"^",8),@VAV@($P(VAS,"^",9))=Z_$S($D(^DIC(13,+Z,0)):"^"_$P(^(0),"^"),1:"") "RTN","VADPT1",33,0) ; "RTN","VADPT1",34,0) ; -- marital status [10 - MS] "RTN","VADPT1",35,0) S Z=$P(VAX,"^",5),@VAV@($P(VAS,"^",10))=Z_$S($D(^DIC(11,+Z,0)):"^"_$P(^(0),"^"),1:"") "RTN","VADPT1",36,0) ; "RTN","VADPT1",37,0) ; -- ethnicity [11 - ET] "RTN","VADPT1",38,0) S X=0 F Y=1:1 S X=+$O(^DPT(DFN,.06,X)) Q:'X D "RTN","VADPT1",39,0) .S NODE=$G(^DPT(DFN,.06,X,0)),Z=$P(NODE,"^",1) I Z D "RTN","VADPT1",40,0) ..S @VAV@($P(VAS,"^",11),Y)=Z_"^"_$P($G(^DIC(10.2,Z,0)),"^",1) "RTN","VADPT1",41,0) ..; -- collection method "RTN","VADPT1",42,0) ..S Z=$P(NODE,"^",2) I Z D "RTN","VADPT1",43,0) ...S @VAV@($P(VAS,"^",11),Y,1)=Z_"^"_$P($G(^DIC(10.3,Z,0)),"^",1) "RTN","VADPT1",44,0) S @VAV@($P(VAS,"^",11))=Y-1 "RTN","VADPT1",45,0) ; "RTN","VADPT1",46,0) ; -- race [12 - RC] "RTN","VADPT1",47,0) S X=0 F Y=1:1 S X=+$O(^DPT(DFN,.02,X)) Q:'X D "RTN","VADPT1",48,0) .S NODE=$G(^DPT(DFN,.02,X,0)),Z=$P(NODE,"^",1) I Z D "RTN","VADPT1",49,0) ..S @VAV@($P(VAS,"^",12),Y)=Z_"^"_$P($G(^DIC(10,Z,0)),"^",1) "RTN","VADPT1",50,0) ..; -- collection method "RTN","VADPT1",51,0) ..S Z=$P(NODE,"^",2) I Z D "RTN","VADPT1",52,0) ...S @VAV@($P(VAS,"^",12),Y,1)=Z_"^"_$P($G(^DIC(10.3,Z,0)),"^",1) "RTN","VADPT1",53,0) S @VAV@($P(VAS,"^",12))=Y-1 "RTN","VADPT1",54,0) ; "RTN","VADPT1",55,0) ; -- current pt preferred language [13 - LG] "RTN","VADPT1",56,0) N VALANGDT,VAPRFLAN,VALANG0,VAY,VALANGDA,X,Y "RTN","VADPT1",57,0) S VALANGDT=9999999,(VAPRFLAN,VALANG0)="" "RTN","VADPT1",58,0) S VALANGDT=$O(^DPT(DFN,.207,"B",VALANGDT),-1) "RTN","VADPT1",59,0) I VALANGDT="" S @VAV@($P(VAS,"^",13))="",@VAV@($P(VAS,"^",13),1)="" "RTN","VADPT1",60,0) I VALANGDT'="" D "RTN","VADPT1",61,0) .S VALANGDA=$O(^DPT(DFN,.207,"B",VALANGDT,0)) "RTN","VADPT1",62,0) .S VALANG0=$G(^DPT(DFN,.207,VALANGDA,0)),Y=$P(VALANG0,U),VAPRFLAN=$P(VALANG0,U,2) "RTN","VADPT1",63,0) .S (VAY,Y)=VALANGDT X ^DD("DD") S VALANGDT=Y "RTN","VADPT1",64,0) .S @VAV@($P(VAS,"^",13))=VAY_"^"_VALANGDT ; FM version^human readable "RTN","VADPT1",65,0) .S @VAV@($P(VAS,"^",13),1)=VALANGDA_"^"_VAPRFLAN ; Pointer^human readable "RTN","VADPT1",66,0) ; "RTN","VADPT1",67,0) ; Preferred Name [14 - NM] "RTN","VADPT1",68,0) ;**1059 Adding Sexual Orientation, Sexual Orientation Description, Pronoun, Pronoun Description, SIGI [14 - SOGI] "RTN","VADPT1",69,0) N SOC,CNTR,PRO,SIGI,SIGIN "RTN","VADPT1",70,0) S @VAV@($P(VAS,"^",14))="" "RTN","VADPT1",71,0) ;Sexual Orientation #.025 multiple "RTN","VADPT1",72,0) S CNTR=1,X=0 F S X=$O(^DPT(DFN,.025,X)) Q:'X!(X="") D "RTN","VADPT1",73,0) .S SOC=$G(^DPT(DFN,.025,X,0)) "RTN","VADPT1",74,0) .S @VAV@($P(VAS,"^",14),1,CNTR)=$G(^DG(47.77,SOC,0)),CNTR=CNTR+1 ;NAME ^ CODE "RTN","VADPT1",75,0) S @VAV@($P(VAS,"^",14),1)=CNTR-1 "RTN","VADPT1",76,0) ;Sexual Orientatin Description #.241 "RTN","VADPT1",77,0) S @VAV@($P(VAS,"^",14),2)=$P($G(^DPT(DFN,.241)),"^") "RTN","VADPT1",78,0) ;Pronoun #.2406 multiple "RTN","VADPT1",79,0) K CNTR,X "RTN","VADPT1",80,0) S CNTR=1,X=0 F S X=$O(^DPT(DFN,.2406,X)) Q:'X!(X="") D "RTN","VADPT1",81,0) .S PRO=$G(^DPT(DFN,.2406,X,0)) "RTN","VADPT1",82,0) .S @VAV@($P(VAS,"^",14),3,CNTR)=$G(^DG(47.78,PRO,0)),CNTR=CNTR+1 ;NAME ^ CODE "RTN","VADPT1",83,0) S @VAV@($P(VAS,"^",14),3)=CNTR-1 "RTN","VADPT1",84,0) ;Pronoun Description #.24061 "RTN","VADPT1",85,0) S @VAV@($P(VAS,"^",14),4)=$P($G(^DPT(DFN,.241)),"^",2) "RTN","VADPT1",86,0) ;SELF IDENTIFIED GENDER #.024 "RTN","VADPT1",87,0) S SIGI=$P($G(^DPT(DFN,.24)),"^",4),SIGIN=$$GET1^DIQ(2,DFN_",",.024) "RTN","VADPT1",88,0) S @VAV@($P(VAS,"^",14),5)=SIGIN_"^"_SIGI ;NAME ^ CODE "RTN","VADPT1",89,0) Q "RTN","VADPT1",90,0) ; "RTN","VADPT1",91,0) 2 ;Other Patient Variables [OPD] "RTN","VADPT1",92,0) N W,Z "RTN","VADPT1",93,0) S VAX=^DPT(DFN,0) "RTN","VADPT1",94,0) ; "RTN","VADPT1",95,0) ; -- city of birth [1 - BC] "RTN","VADPT1",96,0) S @VAV@($P(VAS,"^",1))=$P(VAX,"^",11) "RTN","VADPT1",97,0) ; "RTN","VADPT1",98,0) ; -- state of birth [2 - BS] "RTN","VADPT1",99,0) S Z=$P(VAX,"^",12),@VAV@($P(VAS,"^",2))=Z_$S($D(^DIC(5,+Z,0)):"^"_$P(^(0),"^",1),1:"") "RTN","VADPT1",100,0) ; "RTN","VADPT1",101,0) ; -- occupation [6 - OC] "RTN","VADPT1",102,0) S @VAV@($P(VAS,"^",6))=$P(VAX,"^",7) "RTN","VADPT1",103,0) ; "RTN","VADPT1",104,0) ; -- names "RTN","VADPT1",105,0) S VAX=$S($D(^DPT(DFN,.24)):^(.24),1:"") "RTN","VADPT1",106,0) S @VAV@($P(VAS,"^",3))=$P(VAX,"^",1) ; father's [3 - FN] "RTN","VADPT1",107,0) S @VAV@($P(VAS,"^",4))=$P(VAX,"^",2) ; mother's [4 - MN] "RTN","VADPT1",108,0) S @VAV@($P(VAS,"^",5))=$P(VAX,"^",3) ; mother's maiden [5 - MM] "RTN","VADPT1",109,0) ; "RTN","VADPT1",110,0) ; -- employment status [7 - ES] "RTN","VADPT1",111,0) S VAX=$S($D(^DPT(DFN,.311)):^(.311),1:""),W="EMPLOYED FULL TIME^EMPLOYED PART TIME^NOT EMPLOYED^SELF EMPLOYED^RETIRED^ACTIVE MILITARY DUTY^UNKNOWN" "RTN","VADPT1",112,0) S Z=$P(VAX,"^",15),@VAV@($P(VAS,"^",7))=Z_$S(Z:"^"_$P(W,"^",Z),1:"") "RTN","VADPT1",113,0) ; "RTN","VADPT1",114,0) ; -- PHONE NUMBER [WORK] [8 - WP] "RTN","VADPT1",115,0) I $D(^DPT(DFN,.13)) S @VAV@($P(VAS,"^",8))=$P(^(.13),"^",2) "RTN","VADPT1",116,0) Q "RTN","VADPT1",117,0) ; "RTN","VADPT1",118,0) 3 ;Address [ADD] "RTN","VADPT1",119,0) N VAFOR "RTN","VADPT1",120,0) S VABEG=$S($D(VATEST("ADD",9)):VATEST("ADD",9),1:DT),VAEND=$S($D(VATEST("ADD",10)):VATEST("ADD",10),1:DT) "RTN","VADPT1",121,0) I $S($D(VAPA("P")):1,'$D(^DPT(DFN,.121)):1,$P(^(.121),"^",9)'="Y":1,'$P(^(.121),"^",7):1,$P(^(.121),"^",7)>VABEG:1,'$P(^(.121),"^",8):0,1:$P(^(.121),"^",8)VAACTDT)!(VAEND&(VAEND6:1,1:0) S VAX=.21,VAOA("A")=7 "RTN","VADPT1",193,0) E S VAX="."_$P("33^34^211^331^311^25","^",+VAOA("A")) "RTN","VADPT1",194,0) S VAX(1)=VAX,VAX=$S($D(^DPT(DFN,VAX(1))):^(VAX(1)),1:"") I VAX(1)=.25 S VAX=$P(VAX,"^",1)_"^^"_$P(VAX,"^",2,99) "RTN","VADPT1",195,0) S VAX(2)=0 F I=3,4,5,6,7,8 S VAX(2)=VAX(2)+1,@VAV@($P(VAS,"^",VAX(2)))=$P(VAX,"^",I) "RTN","VADPT1",196,0) S @VAV@($P(VAS,"^",7))="",@VAV@($P(VAS,"^",8))=$P(VAX,"^",9),VAX(2)=8 "RTN","VADPT1",197,0) F I=1,2 S VAX(2)=VAX(2)+1,@VAV@($P(VAS,"^",VAX(2)))=$P(VAX,"^",I) "RTN","VADPT1",198,0) I "^.311^.25"[("^"_VAX(1)_"^") S @VAV@($P(VAS,"^",10))="" "RTN","VADPT1",199,0) S VAZ=@VAV@($P(VAS,"^",5)) I VAZ,$D(^DIC(5,+VAZ,0)) S VAZ(1)=$P(^(0),"^",1),@VAV@($P(VAS,"^",5))=VAZ_"^"_VAZ(1) "RTN","VADPT1",200,0) S VAZIP4=$P($G(^DPT(DFN,.22)),U,VAOA("A")) "RTN","VADPT1",201,0) S @VAV@($P(VAS,U,11))=VAZIP4_$S('$G(VAZIP4):"",($L(VAZIP4)=5):U_VAZIP4,1:U_$E(VAZIP4,1,5)_"-"_$E(VAZIP4,6,9)) "RTN","VADPT1",202,0) Q "RTN","VAFCHFS") 0^10^B33066545^B30461172 "RTN","VAFCHFS",1,0) VAFCHFS ;BIR/DLR-BUILD HFS FILE FOR CAPTURING REPORT DATA ;13 Sep 2021 9:58 AM "RTN","VAFCHFS",2,0) ;;5.3;Registration;**414,477,1059**;Aug 13, 1993;Build 6 "RTN","VAFCHFS",3,0) ;;Routine uses the following supported IAs #2263, #2320, #2336, and #2992. "RTN","VAFCHFS",4,0) HFS(LINETAG) ; "RTN","VAFCHFS",5,0) N VAFCDIR,VAFCFILE,POP "RTN","VAFCHFS",6,0) D HFSOPEN("RPC") I POP D Q "RTN","VAFCHFS",7,0) .S ^TMP("VAFCHFS",$J,1)="ERROR: UNABLE TO ACCESS HFS DIRECTORY "_VAFCDIR_" FILE "_VAFCFILE "RTN","VAFCHFS",8,0) .S ^TMP("VAFCHFS",$J,2)="PLEASE CHECK DIRECTORY WRITE PRIVILEGES." "RTN","VAFCHFS",9,0) U IO "RTN","VAFCHFS",10,0) D @LINETAG "RTN","VAFCHFS",11,0) D HFSCLOSE("RPC") "RTN","VAFCHFS",12,0) ;M RESULTS=^TMP($J) "RTN","VAFCHFS",13,0) Q "RTN","VAFCHFS",14,0) ; "RTN","VAFCHFS",15,0) HFSOPEN(HANDLE) ; "RTN","VAFCHFS",16,0) S VAFCDIR=$$GET^XPAR("SYS","VAFC HFS SCRATCH") "RTN","VAFCHFS",17,0) S VAFCFILE="VAFC"_DUZ_".DAT" "RTN","VAFCHFS",18,0) S IOM=132,IOSL=99999,IOST="P-DUMMY",IOF="""""" "RTN","VAFCHFS",19,0) D OPEN^%ZISH(HANDLE,VAFCDIR,VAFCFILE,"W") Q:POP "RTN","VAFCHFS",20,0) Q "RTN","VAFCHFS",21,0) ; "RTN","VAFCHFS",22,0) HFSCLOSE(HANDLE) ; "RTN","VAFCHFS",23,0) N VAFCDIR,VAFCFILE,VAFCDEL "RTN","VAFCHFS",24,0) D CLOSE^%ZISH(HANDLE) "RTN","VAFCHFS",25,0) K ^TMP("VAFCHFS",$J) "RTN","VAFCHFS",26,0) S VAFCDIR=$$GET^XPAR("SYS","VAFC HFS SCRATCH") "RTN","VAFCHFS",27,0) S VAFCFILE="VAFC"_DUZ_".DAT",VAFCDEL(VAFCFILE)="" "RTN","VAFCHFS",28,0) S X=$$FTG^%ZISH(VAFCDIR,VAFCFILE,$NAME(^TMP("VAFCHFS",$J,1)),3) "RTN","VAFCHFS",29,0) S X=$$DEL^%ZISH(VAFCDIR,$NA(VAFCDEL)) "RTN","VAFCHFS",30,0) Q "RTN","VAFCHFS",31,0) ; "RTN","VAFCHFS",32,0) HFSGET(RM,GOTO) ; "RTN","VAFCHFS",33,0) ;RM=Right margin "RTN","VAFCHFS",34,0) S:'$G(RM) RM=80 "RTN","VAFCHFS",35,0) N ZTQUEUED,VAFCHFS,VAFCSUB,VAFCIO "RTN","VAFCHFS",36,0) S VAFCHFS="VAFC_"_$J_".DAT",VAFCSUB="VAFCDATA" "RTN","VAFCHFS",37,0) D OPEN(.RM,.VAFCHFS,"W",.VAFCIO) "RTN","VAFCHFS",38,0) D @GOTO "RTN","VAFCHFS",39,0) D CLOSE(.VAFCRM,.VAFCHFS,.VAFCSUB,.VAFCIO) "RTN","VAFCHFS",40,0) Q "RTN","VAFCHFS",41,0) ; "RTN","VAFCHFS",42,0) OPEN(VAFCRM,VAFCHFS,VAFCMODE,VAFCIO) ; -- open WORKSTATION device "RTN","VAFCHFS",43,0) ; VAFCRM: right margin "RTN","VAFCHFS",44,0) ; VAFCHFS: host file name "RTN","VAFCHFS",45,0) ; VAFCMODE: open file in 'R'ead or 'W'rite mode "RTN","VAFCHFS",46,0) S ZTQUEUED="" K IOPAR "RTN","VAFCHFS",47,0) S IOP="OR WORKSTATION;"_$G(VAFCRM,80) "RTN","VAFCHFS",48,0) S %ZIS("HFSMODE")=VAFCMODE,%ZIS("HFSNAME")=VAFCHFS "RTN","VAFCHFS",49,0) D ^%ZIS K IOP,%ZIS "RTN","VAFCHFS",50,0) U IO S VAFCIO=IO "RTN","VAFCHFS",51,0) Q "RTN","VAFCHFS",52,0) ; "RTN","VAFCHFS",53,0) CLOSE(VAFCRM,VAFCHFS,VAFCSUB,VAFCIO) ; -- close WORKSTATION device "RTN","VAFCHFS",54,0) ; VAFCSUB: unique subscript name for output "RTN","VAFCHFS",55,0) I IO=VAFCIO D ^%ZISC "RTN","VAFCHFS",56,0) U IO "RTN","VAFCHFS",57,0) D USEHFS "RTN","VAFCHFS",58,0) U IO "RTN","VAFCHFS",59,0) Q "RTN","VAFCHFS",60,0) USEHFS ; -- use host file to build global array "RTN","VAFCHFS",61,0) N IO,VAFCK,SECTION "RTN","VAFCHFS",62,0) S SECTION=0 "RTN","VAFCHFS",63,0) S VAFCK=$$FTG^%ZISH(,VAFCHFS,$NA(^TMP($J,1)),2) I 'VAFCK Q "RTN","VAFCHFS",64,0) N VAFCRR S VAFCRR(VAFCHFS)="" "RTN","VAFCHFS",65,0) S VAFCK=$$DEL^%ZISH("",$NA(VAFCRR)) "RTN","VAFCHFS",66,0) Q "RTN","VAFCHFS",67,0) EDIT ;edit the HFS directory "RTN","VAFCHFS",68,0) D EDITPAR^XPAREDIT("VAFC HFS SCRATCH") "RTN","VAFCHFS",69,0) Q "RTN","VAFCHFS",70,0) DSPPDAT(VAFC) ; "RTN","VAFCHFS",71,0) ; Output "RTN","VAFCHFS",72,0) ; VAFC - array passed back with the display formatted PDAT call "RTN","VAFCHFS",73,0) N CNT,X,TXT,OVF "RTN","VAFCHFS",74,0) S CNT=0,X=0 F S X=$O(^TMP("VAFCHFS",$J,X)) Q:'X S TXT=^TMP("VAFCHFS",$J,X) D I $S<3000 S VAFC(CNT)="*** QUERY TERMINATED DUE TO VOLUME OF DATA FOR SELECTED DATE RANGE ***" Q ;**477 "RTN","VAFCHFS",75,0) . I $E(TXT,1,20)="Treating Facilities:" S VAFC(CNT)="" S CNT=CNT+1 "RTN","VAFCHFS",76,0) . I $E(TXT,1,12)="Subscribers:" S VAFC(CNT)="" S CNT=CNT+1 "RTN","VAFCHFS",77,0) . I $E(TXT,1,12)="ICN History:" S VAFC(CNT)="" S CNT=CNT+1 "RTN","VAFCHFS",78,0) . I $E(TXT,1,13)="CMOR History:" S VAFC(CNT)="" S CNT=CNT+1 "RTN","VAFCHFS",79,0) . I $E(TXT,1,28)="CMOR Change Request History:" S VAFC(CNT)="" S CNT=CNT+1 "RTN","VAFCHFS",80,0) . I TXT'="",$E(TXT,1,12)'="Enter RETURN" D "RTN","VAFCHFS",81,0) .. S VAFC(CNT)=^TMP("VAFCHFS",$J,X) "RTN","VAFCHFS",82,0) .. ;**1059,Story 11114,11118 (mko): Account for lines > 255 characters; overflow is in "OVF" nodes. "RTN","VAFCHFS",83,0) .. S OVF="" F S OVF=$O(^TMP("VAFCHFS",$J,X,"OVF",OVF)) Q:'OVF S VAFC(CNT)=VAFC(CNT)_$G(^TMP("VAFCHFS",$J,X,"OVF",OVF)) "RTN","VAFCHFS",84,0) .. S CNT=CNT+1 "RTN","VAFCHFS",85,0) K ^TMP("VAFCHFS",$J) "RTN","VAFCHFS",86,0) Q "RTN","VAFCHFS",87,0) CREATE ;create entry in File #8989.51 for remote HFS functionality "RTN","VAFCHFS",88,0) N VAFC,VAFC1,ARRAY,Y,VAFCY "RTN","VAFCHFS",89,0) S VAFC=$$FIND1^DIC(8989.51,"","X","VAFC HFS SCRATCH","B","","ERR") "RTN","VAFCHFS",90,0) I VAFC>0 D "RTN","VAFCHFS",91,0) . K DIC,DA,DO,X,DIE,DR S DIC=8989.51,DIC(0)="X",X="VAFC HFS SCRATCH" D ^DIC "RTN","VAFCHFS",92,0) . S VAFCY=+Y L +^XTV(8989.51,VAFCY):5 "RTN","VAFCHFS",93,0) . S DIE=DIC,DA=+Y S DR=".02///Scratch HFS Directory;.03///0;.05///Directory name;1.1///F;1.2///1:250;1.3///Enter in an OS level directory with read/write/edit/delete privileges.;30///1",DR(2,8989.513)=".01///1;.02///4.2" D ^DIE D "RTN","VAFCHFS",94,0) .. L -^XTV(8989.51,VAFCY) "RTN","VAFCHFS",95,0) .. K DIC,DA,DO,X,DIE,DR "RTN","VAFCHFS",96,0) . S VAFC1=$$FIND1^DIC(8989.51,"","X","VAFC HFS SCRATCH","B","","ERR") "RTN","VAFCHFS",97,0) . S ARRAY(1,1)="This fields should contain the directory specifications for the Kernel" "RTN","VAFCHFS",98,0) . S ARRAY(1,2)="OPEN^%ZISH call. The directory should be wide open with" "RTN","VAFCHFS",99,0) . S ARRAY(1,3)="read/write/edit/delete privileges." "RTN","VAFCHFS",100,0) . S ARRAY(1,4)="Example:" "RTN","VAFCHFS",101,0) . S ARRAY(1,5)="A2$dir aij$:[000000]tcp$spool.dir /own/prot" "RTN","VAFCHFS",102,0) . S ARRAY(1,6)=" Directory AIJ$:[000000]" "RTN","VAFCHFS",103,0) . S ARRAY(1,7)=" TCP$SPOOL.DIR;1 [SYSTEM] (RWED,RWED,RWED,RWED)" "RTN","VAFCHFS",104,0) . D WP^DIE(8989.51,VAFC1_",",20,"","ARRAY(1)") "RTN","VAFCHFS",105,0) I VAFC<1 D "RTN","VAFCHFS",106,0) . K FDA "RTN","VAFCHFS",107,0) . S FDA(1,8989.51,"+1,",.01)="VAFC HFS SCRATCH" "RTN","VAFCHFS",108,0) . S FDA(1,8989.51,"+1,",.02)="Scratch HFS Directory" "RTN","VAFCHFS",109,0) . S FDA(1,8989.51,"+1,",.03)=0 "RTN","VAFCHFS",110,0) . S FDA(1,8989.51,"+1,",.05)="Directory name" "RTN","VAFCHFS",111,0) . S FDA(1,8989.51,"+1,",1.1)="F" "RTN","VAFCHFS",112,0) . S FDA(1,8989.51,"+1,",1.2)="1:250" "RTN","VAFCHFS",113,0) . S FDA(1,8989.51,"+1,",1.3)="Enter in an OS level directory with read/write/edit/delete privileges." "RTN","VAFCHFS",114,0) . S FDA(1,8989.513,"+2,+1,",.01)=1 "RTN","VAFCHFS",115,0) . S FDA(1,8989.513,"+2,+1,",.02)="4.2" "RTN","VAFCHFS",116,0) . D UPDATE^DIE("","FDA(1)","FDAIEN") K FDA "RTN","VAFCHFS",117,0) . S VAFC1=$$FIND1^DIC(8989.51,"","X","VAFC HFS SCRATCH","B","","ERR") "RTN","VAFCHFS",118,0) . S ARRAY(1,1)="This fields should contain the directory specifications for the Kernel" "RTN","VAFCHFS",119,0) . S ARRAY(1,2)="OPEN^%ZISH call. The directory should be wide open with" "RTN","VAFCHFS",120,0) . S ARRAY(1,3)="read/write/edit/delete privileges." "RTN","VAFCHFS",121,0) . S ARRAY(1,4)="Example:" "RTN","VAFCHFS",122,0) . S ARRAY(1,5)="A2$dir aij$:[000000]tcp$spool.dir /own/prot" "RTN","VAFCHFS",123,0) . S ARRAY(1,6)=" Directory AIJ$:[000000]" "RTN","VAFCHFS",124,0) . S ARRAY(1,7)=" TCP$SPOOL.DIR;1 [SYSTEM] (RWED,RWED,RWED,RWED)" "RTN","VAFCHFS",125,0) . D WP^DIE(8989.51,VAFC1_",",20,"","ARRAY(1)") "RTN","VAFCHFS",126,0) D EDIT "RTN","VAFCHFS",127,0) Q "RTN","VAFCPDAT") 0^3^B83449271^B63787008 "RTN","VAFCPDAT",1,0) VAFCPDAT ;BIR/CML/ALS-DISPLAY MPI/PD INFORMATION FOR SELECTED PATIENT ; 7/12/16 11:11am "RTN","VAFCPDAT",2,0) ;;5.3;Registration;**333,414,474,505,707,712,837,863,876,902,926,937,950,1059**;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;.352;.353;.354;.355;.357;.358;.2405;.025;.0251;.2406;.24061;991.11;.1151;.1152;.1153;.1154;.1155;.1156;.11571;.11572;.11573" "RTN","VAFCPDAT",24,0) S DA=DFN,DIQ(0)="EI",DIQ="DNODE" D EN^DIQ1 K DIC,DR,DA,DIQ ;**707,712,863,876;1059 "RTN","VAFCPDAT",25,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",26,0) N DODD,DODENTBY,DODSRC,DODLUPD,DODLEBY,DODOPT,REST1,REST2,REST3,RESCTY,RESST,RESZP,RESP,RESPC,RESCN,ITIN,SXOD,SXO,PRN,PRND,EN,RCCODE,RCNAME ;**926 Story 323009 (ckn) **1059 VAMPI-11114,VAMPI-11118,VAMPI-11120, VAMPI-11121 "RTN","VAFCPDAT",27,0) S NAME=$G(DNODE(2,DFN,.01,"E")),SSN=$G(DNODE(2,DFN,.09,"E")),SSNVER=$G(DNODE(2,DFN,.0907,"E")) ;**707 "RTN","VAFCPDAT",28,0) S DOB=$$FMTE^XLFDT($G(DNODE(2,DFN,.03,"I"))) "RTN","VAFCPDAT",29,0) S MBI=$G(DNODE(2,DFN,994,"I")),MBI=$S(MBI="Y":"YES",MBI="N":"NO",1:"NULL") ;**707 "RTN","VAFCPDAT",30,0) S SEX=$G(DNODE(2,DFN,.02,"E")),SIGEN=$G(DNODE(2,DFN,.024,"E")),DOD=$G(DNODE(2,DFN,.351,"E")) ;**876 - MVI_3432 (cml) "RTN","VAFCPDAT",31,0) S CLAIM=$G(DNODE(2,DFN,.313,"E")) S:CLAIM="" CLAIM="None" "RTN","VAFCPDAT",32,0) S BAI=$G(DNODE(2,DFN,.121,"E")) ;**712 "RTN","VAFCPDAT",33,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",34,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",35,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",36,0) S PROVINCE=$G(DNODE(2,DFN,.1171,"E")),POSTCODE=$G(DNODE(2,DFN,.1172,"E")) "RTN","VAFCPDAT",37,0) S PHN=$G(DNODE(2,DFN,.131,"E")),PREAS=$G(DNODE(2,DFN,.0906,"E")) ;**707 "RTN","VAFCPDAT",38,0) S MNODE=$$MPINODE^MPIFAPI(DFN) I +MNODE=-1 S MNODE="^^^^^^^^" "RTN","VAFCPDAT",39,0) S (ICN,SCN,SCORE,SCRDT,DIFF,TIN,FIN)="" ;**837, MVI_883 "RTN","VAFCPDAT",40,0) S ICN=$$GETICN^MPIF001(DFN) S:(+ICN=-1) ICN="None" ;**863 - MVI_2351 (ptd) "RTN","VAFCPDAT",41,0) ;**926 - Story 323009 (ckn): DOD fields "RTN","VAFCPDAT",42,0) I DOD'="" D "RTN","VAFCPDAT",43,0) .;Date of Death Entered By ;Date of Death Source of Notification ;Date of Death Last Updated ;Date of Death Last Edited By ;Date of Death Supporting Document Type ;Date of Death Option Used "RTN","VAFCPDAT",44,0) . S DODENTBY=$G(DNODE(2,DFN,.352,"E")),DODSRC=$G(DNODE(2,DFN,.353,"E")),DODLUPD=$G(DNODE(2,DFN,.354,"E")),DODLEBY=$G(DNODE(2,DFN,.355,"E")) "RTN","VAFCPDAT",45,0) . S DODD=$G(DNODE(2,DFN,.357,"E")),DODOPT=$G(DNODE(2,DFN,.358,"E")) "RTN","VAFCPDAT",46,0) ;S CMOR=$$GET1^DIQ(4,+$P($G(MNODE),"^",3)_",",.01) S:CMOR="" CMOR="None" ;removed for **837, MVI_918 "RTN","VAFCPDAT",47,0) I $E(ICN,1,3)=SITENUM S GOT=0 I $P($G(MNODE),"^",4)=""!('$D(^DPT("AICNL",1,DFN))) S ICN=ICN_"**" "RTN","VAFCPDAT",48,0) S TIN=$P($G(MNODE),"^",8),FIN=$P($G(MNODE),"^",9) ;**837, MVI_883 "RTN","VAFCPDAT",49,0) ;**1059 VAMPI-11114,VAMPI-11118,VAMPI-11120, VAMPI-11121 "RTN","VAFCPDAT",50,0) S REST1=$G(DNODE(2,DFN,.1151,"E")),REST2=$G(DNODE(2,DFN,.1152,"E")),REST3=$G(DNODE(2,DFN,.1153,"E")),RESCTY=$G(DNODE(2,DFN,.1154,"E")),RESST=$G(DNODE(2,DFN,.1155,"E")) "RTN","VAFCPDAT",51,0) S RESZP=$G(DNODE(2,DFN,.1156,"E")),RESP=$G(DNODE(2,DFN,.11571,"E")),RESPC=$G(DNODE(2,DFN,.11572,"E")) "RTN","VAFCPDAT",52,0) S RESCN=$G(DNODE(2,DFN,.11573,"I")),(CCODE,CNAME)="" I RESCN]"" S RCCODE=$$GET1^DIQ(779.004,+COUNTRY_",",.01),RCNAME=$$GET1^DIQ(779.004,+COUNTRY_",",1.3) "RTN","VAFCPDAT",53,0) S ITIN=$G(DNODE(2,DFN,991.11,"E")),SXOD=$G(DNODE(2,DFN,.0251,"E")),PRND=$G(DNODE(2,DFN,.24061,"E")) "RTN","VAFCPDAT",54,0) ; "RTN","VAFCPDAT",55,0) I $D(NOTRPC) W @IOF,! "RTN","VAFCPDAT",56,0) W !,"MPI/PD Data for: ",NAME," (DFN #",DFN,")" "RTN","VAFCPDAT",57,0) ; check for patient sensitivity and user security "RTN","VAFCPDAT",58,0) N RESULT,RGSENS,SENSTV,DA,DR,DIC,DIQ,VAFCSEN "RTN","VAFCPDAT",59,0) D PTSEC^DGSEC4(.RESULT,DFN,0,"MPI/PD Patient Inquiry^MPI/PD Patient Inquiry") "RTN","VAFCPDAT",60,0) I RESULT(1)=-1 W !!,"Access denied: Required parameters not defined" G QUIT "RTN","VAFCPDAT",61,0) I RESULT(1)>0 W ?50,"***PATIENT MARKED SENSITIVE***" "RTN","VAFCPDAT",62,0) I RESULT(1)=3 W !!,"Access not allowed on your own PATIENT (#2) file entry" G QUIT "RTN","VAFCPDAT",63,0) I RESULT(1)=4 W !!,"Access denied: Your SSN is not defined" G QUIT "RTN","VAFCPDAT",64,0) I RESULT(1)<3 D "RTN","VAFCPDAT",65,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",66,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",67,0) W !,"Printed ",HDT," at ",SITENAM,!,LN "RTN","VAFCPDAT",68,0) S $Y=$Y+1 "RTN","VAFCPDAT",69,0) ;next 7 lines modified for **707 "RTN","VAFCPDAT",70,0) W !,"ICN : ",ICN ;CMOR removed **837, MVI_918 "RTN","VAFCPDAT",71,0) W !,"SSN : ",SSN "RTN","VAFCPDAT",72,0) I SSNVER'="" W !?9,"SSN Verification Status: ",SSNVER "RTN","VAFCPDAT",73,0) I PREAS'="" W !?9,"Pseudo SSN Reason: ",PREAS "RTN","VAFCPDAT",74,0) I ITIN'="" W !?9,"Individual Tax ID: ",ITIN ;**1059 VAMPI-11114,VAMPI-11118,VAMPI-11120, VAMPI-11121 "RTN","VAFCPDAT",75,0) ; Story 603957 (elz) change sex to birth sex, lined up with DOB and DOD at the same time "RTN","VAFCPDAT",76,0) W !,"Birth Sex : ",SEX "RTN","VAFCPDAT",77,0) ;**1059 VAMPI-11114,VAMPI-11118,VAMPI-11120, VAMPI-11121 "RTN","VAFCPDAT",78,0) ;SEXUAL ORIENTATION "RTN","VAFCPDAT",79,0) I $O(^DPT(DFN,.025,0))'="" W !,"Sexual Orientation: " D "RTN","VAFCPDAT",80,0) .S EN=0 F S EN=$O(^DPT(DFN,.025,EN)) Q:'EN D "RTN","VAFCPDAT",81,0) ..S SXO=$G(^DPT(DFN,.025,EN,0)) "RTN","VAFCPDAT",82,0) ..W ?20,$P($G(^DG(47.77,SXO,0)),"^"),! "RTN","VAFCPDAT",83,0) I SXOD'="" W !,"Sexual Orientation Description: ",SXOD "RTN","VAFCPDAT",84,0) ;PRONOUN "RTN","VAFCPDAT",85,0) I $O(^DPT(DFN,.2406,0))'="" W !,"Pronoun: " D "RTN","VAFCPDAT",86,0) .S EN=0 F S EN=$O(^DPT(DFN,.2406,EN)) Q:'EN D "RTN","VAFCPDAT",87,0) ..S PRN=$G(^DPT(DFN,.2406,EN,0)) "RTN","VAFCPDAT",88,0) ..W ?20,$P($G(^DG(47.78,PRN,0)),"^"),! "RTN","VAFCPDAT",89,0) I PRND'="" W !,"Pronoun Description: ",PRND "RTN","VAFCPDAT",90,0) I SIGEN'="" W !,"Self-Identified Gender Identity: ",SIGEN ;**876 - MVI_3432 (cml) **902 - MVI_4730 (cml) MOVED HERE IN 1059 "RTN","VAFCPDAT",91,0) W !,"Claim # : ",CLAIM "RTN","VAFCPDAT",92,0) W !,"Date of Birth: ",DOB "RTN","VAFCPDAT",93,0) ;**926 - Story 323009 (ckn): DOD fields "RTN","VAFCPDAT",94,0) I DOD]"" D "RTN","VAFCPDAT",95,0) . W !,"Date of Death: ",DOD "RTN","VAFCPDAT",96,0) . I DODENTBY]"" W !,?15,"Entered By: ",?42,DODENTBY "RTN","VAFCPDAT",97,0) . I DODSRC]"" W !,?15,"Source of Notification: ",?42,DODSRC "RTN","VAFCPDAT",98,0) . I DODLUPD]"" W !,?15,"Last Updated: ",?42,DODLUPD "RTN","VAFCPDAT",99,0) . I DODLEBY]"" W !,?15,"Last Edited By: ",?42,DODLEBY "RTN","VAFCPDAT",100,0) . I DODD]"" W !,?15,"Supporting Document Type: ",?42,DODD "RTN","VAFCPDAT",101,0) . I DODOPT]"" W !,?15,"Option Used: ",?42,DODOPT "RTN","VAFCPDAT",102,0) I MBI]"" W !,"Multiple Birth Indicator: ",MBI ;**707 "RTN","VAFCPDAT",103,0) I TIN]"" W !,"DoD Temporary ID Number : ",TIN ;**837, MVI_883 "RTN","VAFCPDAT",104,0) I FIN]"" W !,"DoD Foreign ID Number : ",FIN ;**837, MVI_883 "RTN","VAFCPDAT",105,0) W !,"Correspondence Address:" I BAI'="" W " (Bad Address Indicator: ",BAI,")" ;**1059 VAMPI-11114,VAMPI-11118,VAMPI-11120, VAMPI-11121 "RTN","VAFCPDAT",106,0) I STR1'="" W !?9,STR1 "RTN","VAFCPDAT",107,0) I STR2'="" W !?9,STR2 "RTN","VAFCPDAT",108,0) I STR3'="" W !?9,STR3 "RTN","VAFCPDAT",109,0) I COUNTRY=""!(CCODE="USA") D ;USA Address **863 - MVI_1902 (ptd) "RTN","VAFCPDAT",110,0) .I CTY]"" W !?9,$E(CTY,1,20)_", "_$G(ST)_" "_$G(ZIP) "RTN","VAFCPDAT",111,0) I COUNTRY]"",CCODE'="USA" D ;Foreign Address "RTN","VAFCPDAT",112,0) .I CTY]""!(PROVINCE]"")!(POSTCODE]"") D "RTN","VAFCPDAT",113,0) ..I PROVINCE]"" W !?9,CTY_", "_PROVINCE_" ("_CNAME_") "_POSTCODE "RTN","VAFCPDAT",114,0) ..I PROVINCE="" W !?9,CTY_", "_"("_CNAME_") "_POSTCODE "RTN","VAFCPDAT",115,0) W !,"Residential Address: " "RTN","VAFCPDAT",116,0) I REST1'="" W !?9,REST1 "RTN","VAFCPDAT",117,0) I REST2'="" W !?9,REST2 "RTN","VAFCPDAT",118,0) I REST3'="" W !?9,REST3 "RTN","VAFCPDAT",119,0) I $G(RESCN)=""!($G(RCCODE)="USA") I RESCTY]"" W !?9,$E(RESCTY,1,20)_", "_$G(RESST)_" "_$G(RESZP) "RTN","VAFCPDAT",120,0) I RESCN'="",$G(RCCODE)'="USA" D ;Foreign Address "RTN","VAFCPDAT",121,0) .I RESCTY]""!(RESP]"")!(RESPC]"") D "RTN","VAFCPDAT",122,0) ..I RESP]"" W !?9,RESCTY_", "_RESP_" ("_RCNAME_") "_RESPC "RTN","VAFCPDAT",123,0) ..I RESP="" W !?9,RESCTY_", "_"("_RCNAME_") "_RESPC "RTN","VAFCPDAT",124,0) I PHN'="" W !,"Phone #: ",PHN "RTN","VAFCPDAT",125,0) I $G(IOSL)<30&($E(IOST,1,2)="C-") D "RTN","VAFCPDAT",126,0) .I $Y>23 D "RTN","VAFCPDAT",127,0) ..S DIR(0)="E" D D ^DIR K DIR I 'Y S QFLG=1 "RTN","VAFCPDAT",128,0) ...S SS=22-$Y F JJ=1:1:SS W ! "RTN","VAFCPDAT",129,0) ..S $Y=0 "RTN","VAFCPDAT",130,0) I QFLG=1 G QUIT "RTN","VAFCPDAT",131,0) ; "RTN","VAFCPDAT",132,0) TF ;List Treating Facilities for this patient "RTN","VAFCPDAT",133,0) D TFHDR "RTN","VAFCPDAT",134,0) K TFARR "RTN","VAFCPDAT",135,0) S TF=0 F S TF=$O(^DGCN(391.91,"APAT",DFN,TF)) Q:'TF D "RTN","VAFCPDAT",136,0) .S TFIEN=$O(^DGCN(391.91,"APAT",DFN,TF,0)) "RTN","VAFCPDAT",137,0) . S DIC="^DGCN(391.91,",DR=".02;.03;.07",DA=TFIEN,DIQ(0)="EI",DIQ="TFDATA" "RTN","VAFCPDAT",138,0) . D EN^DIQ1 K DIC,DA,DR,DIQ "RTN","VAFCPDAT",139,0) . S INST="",STATION="" "RTN","VAFCPDAT",140,0) . S INST=$G(TFDATA(391.91,TFIEN,.02,"I")) "RTN","VAFCPDAT",141,0) . I INST'="" D "RTN","VAFCPDAT",142,0) .. S DIC=4,DR="99",DA=INST,DIQ(0)="E",DIQ="STA" "RTN","VAFCPDAT",143,0) .. D EN^DIQ1 K DIC,DA,DR,DIQ "RTN","VAFCPDAT",144,0) .. S STATION=$G(STA(4,INST,99,"E")) "RTN","VAFCPDAT",145,0) . S TFNM=$G(TFDATA(391.91,TFIEN,.02,"E")) "RTN","VAFCPDAT",146,0) . S LSTDT=$G(TFDATA(391.91,TFIEN,.03,"I")) S:LSTDT="" LSTDT="none found" "RTN","VAFCPDAT",147,0) . S LSTSORT=9999999 "RTN","VAFCPDAT",148,0) . I +LSTDT S LSTSORT=9999999-LSTDT,LSTDT=$$FMTE^XLFDT($E(LSTDT,1,12)) "RTN","VAFCPDAT",149,0) . S REACODE=$G(TFDATA(391.91,TFIEN,.07,"E")) S REASON="none found" "RTN","VAFCPDAT",150,0) . I REACODE'="" D "RTN","VAFCPDAT",151,0) .. S DIC="^VAT(391.72,",DIC(0)="Z",X=REACODE D ^DIC K DIC,X "RTN","VAFCPDAT",152,0) .. S REASON=$P($G(Y(0)),"^",4) "RTN","VAFCPDAT",153,0) . S TFARR(LSTSORT,TFNM)=TFIEN_"^"_REASON_"^"_$G(STATION)_"^"_LSTDT "RTN","VAFCPDAT",154,0) I '$D(TFARR) W !,"No Treating Facilities found." G SUB "RTN","VAFCPDAT",155,0) S LSTSORT=0 F S LSTSORT=$O(TFARR(LSTSORT)) Q:'LSTSORT D G:QFLG QUIT "RTN","VAFCPDAT",156,0) .S TFNM="" F S TFNM=$O(TFARR(LSTSORT,TFNM)) Q:TFNM="" D Q:QFLG "RTN","VAFCPDAT",157,0) ..S REASON=$P(TFARR(LSTSORT,TFNM),"^",2) "RTN","VAFCPDAT",158,0) ..S STATION=$P(TFARR(LSTSORT,TFNM),"^",3) "RTN","VAFCPDAT",159,0) ..S LSTDT=$P(TFARR(LSTSORT,TFNM),"^",4) "RTN","VAFCPDAT",160,0) ..I $Y+3>IOSL&($E(IOST,1,2)="C-") D Q:QFLG "RTN","VAFCPDAT",161,0) ...S LNQ=22 D SS Q:QFLG "RTN","VAFCPDAT",162,0) ...W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 D TFHDR "RTN","VAFCPDAT",163,0) ..W !,$E(TFNM,1,20),?22,$G(STATION),?32,LSTDT,?54,REASON "RTN","VAFCPDAT",164,0) SUB ;removed listing of subscribers for RG*1.0*23 "RTN","VAFCPDAT",165,0) HIS ;find ICN history "RTN","VAFCPDAT",166,0) I '$O(^DPT(DFN,"MPIFHIS",0)) G CONT "RTN","VAFCPDAT",167,0) ; "RTN","VAFCPDAT",168,0) I $Y+4>IOSL&($E(IOST,1,2)="C-") D G:QFLG QUIT "RTN","VAFCPDAT",169,0) .S LNQ=22 D SS Q:QFLG "RTN","VAFCPDAT",170,0) .W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 "RTN","VAFCPDAT",171,0) D ICNHDR "RTN","VAFCPDAT",172,0) S HIS=0 F S HIS=$O(^DPT(DFN,"MPIFHIS",HIS)) Q:'HIS D G:QFLG QUIT "RTN","VAFCPDAT",173,0) .S DIC=2,DR="992",DR(2.0992)=".01;1;3",DA=DFN,DA(2.0992)=HIS ;**863 - MVI_2351 (ptd) "RTN","VAFCPDAT",174,0) .S DIQ(0)="E",DIQ="HISNODE" "RTN","VAFCPDAT",175,0) .D EN^DIQ1 K DIC,DA,DR,DIQ "RTN","VAFCPDAT",176,0) .S HISICN=$G(HISNODE(2.0992,HIS,.01,"E")) "RTN","VAFCPDAT",177,0) .S HISCHK=$G(HISNODE(2.0992,HIS,1,"E")) ;**863 - MVI_2351 (ptd) history checksum "RTN","VAFCPDAT",178,0) .S HFULLICN=HISICN_$S(HISCHK]"":"V"_HISCHK,1:"") ;**863 - MVI_2351 (ptd) History full ICN "RTN","VAFCPDAT",179,0) .S HISDT=$G(HISNODE(2.0992,HIS,3,"E")) "RTN","VAFCPDAT",180,0) .I $Y+3>IOSL&($E(IOST,1,2)="C-") D Q:QFLG "RTN","VAFCPDAT",181,0) ..S LNQ=22 D SS Q:QFLG "RTN","VAFCPDAT",182,0) ..W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 D ICNHDR "RTN","VAFCPDAT",183,0) .W !,HFULLICN I HISDT]"" W " - changed ",HISDT ;**863 - MVI_2351 (ptd) "RTN","VAFCPDAT",184,0) ; "RTN","VAFCPDAT",185,0) CONT ;Continue to VAFCPDT2 for extended data "RTN","VAFCPDAT",186,0) ;D CMORHIS^VAFCPDT2 ;CMOR History removed, called changed to EXT^VAFCPDT2 **837, MVI_918 "RTN","VAFCPDAT",187,0) D EXT^VAFCPDT2 "RTN","VAFCPDAT",188,0) DONE ; "RTN","VAFCPDAT",189,0) I QFLG G QUIT "RTN","VAFCPDAT",190,0) I ($E(IOST,1,2)="C-") S LNQ=24 D SS "RTN","VAFCPDAT",191,0) ; "RTN","VAFCPDAT",192,0) QUIT ; "RTN","VAFCPDAT",193,0) K %,CMOR,DIC,DIR,DIRUT,DNODE,GOT,HDT,HFULLICN,HIS,HISCHK,HISDT,HISICN,JJ,LIEN "RTN","VAFCPDAT",194,0) K LINST,LN,LSTDT,MNODE,REACODE,REASON,SCN,SCORE,SITE,SITEIEN,SITENAM,SITENUM "RTN","VAFCPDAT",195,0) K SS,SUBN,SUBARR,TERM,TERMDT,TF,TFARR,TFDATA,TFIEN,TFNM,Y,D,CHG,CHGNODE "RTN","VAFCPDAT",196,0) K HISNODE,DIFF,INST,RGDFN,SCRDT,STATION,STA,LN2,NAME,LSTSORT,LNQ,QFLG,MBI "RTN","VAFCPDAT",197,0) Q "RTN","VAFCPDAT",198,0) TFHDR ; "RTN","VAFCPDAT",199,0) W !!,"Treating Facilities:",?22,"Station:",?32,"DT Last Treated",?54,"Event Reason" "RTN","VAFCPDAT",200,0) W !,"--------------------",?22,"--------",?32,"---------------",?54,"------------" "RTN","VAFCPDAT",201,0) Q "RTN","VAFCPDAT",202,0) ICNHDR W !!,"ICN History:",!,"------------" "RTN","VAFCPDAT",203,0) Q "RTN","VAFCPDAT",204,0) ; "RTN","VAFCPDAT",205,0) SS S DIR(0)="E" D D ^DIR K DIR I 'Y S QFLG=1 "RTN","VAFCPDAT",206,0) .S SS=LNQ-$Y F JJ=1:1:SS W ! "RTN","VAFCPDAT",207,0) Q "RTN","VAFCPTED") 0^8^B71161644^B45940753 "RTN","VAFCPTED",1,0) VAFCPTED ;ISA/RJS,Zoltan-EDIT EXISTING PATIENT ;8/9/21 13:59 "RTN","VAFCPTED",2,0) ;;5.3;Registration;**149,333,756,837,974,1059**;Aug 13, 1993;Build 6 "RTN","VAFCPTED",3,0) ; "RTN","VAFCPTED",4,0) EDIT(DGDFN,ARRAY,STRNGDR) ;-- Edits existing patient "RTN","VAFCPTED",5,0) ;Input: "RTN","VAFCPTED",6,0) ; DGDFN - IEN in the PATIENT (#2) file "RTN","VAFCPTED",7,0) ; ARRAY - Array containing fields to be edited. "RTN","VAFCPTED",8,0) ; Ex. ARRAY(.111)="123 STREET" or ARRAY(2,.111)="123... "RTN","VAFCPTED",9,0) ; STRNGDR - String of delimited PATIENT (#2) file fields in the order "RTN","VAFCPTED",10,0) ; in which the fields will be processed by DIE. "RTN","VAFCPTED",11,0) ; Ex. ".01;.03;.05..." "RTN","VAFCPTED",12,0) ;Output: "RTN","VAFCPTED",13,0) ; No output "RTN","VAFCPTED",14,0) ; "RTN","VAFCPTED",15,0) S U="^" "RTN","VAFCPTED",16,0) N LOCKFLE,FLD,ZTQUEUED,DIQUIET,VAFCX,STRNG "RTN","VAFCPTED",17,0) S (ZTQUEUED,DIQUIET)=1 "RTN","VAFCPTED",18,0) L +^DPT(DGDFN):60 "RTN","VAFCPTED",19,0) S LOCKFLE=$T ; Need to remember whether the lock went through. "RTN","VAFCPTED",20,0) ;process the given PATIENT file DR string in the given order "RTN","VAFCPTED",21,0) S STRNG=STRNGDR F VAFCX=1:1 Q:STRNG="" S FLD=$P(STRNGDR,";",VAFCX) S STRNG=$P(STRNGDR,";",VAFCX+1,$L(STRNGDR,";")) D LOAD "RTN","VAFCPTED",22,0) ; "RTN","VAFCPTED",23,0) ;Do Address Bulletin if incoming Address does not equal existing "RTN","VAFCPTED",24,0) ;Address - removed bulletin with patch DG*5.3*333 "RTN","VAFCPTED",25,0) ;I $D(@ARRAY@(.111))!$D(@ARRAY@(.112))!$D(@ARRAY@(.113))!$D(@ARRAY@(.114))!$D(@ARRAY@(.115))!$D(@ARRAY@(.117))!$D(@ARRAY@(.1112)) D "RTN","VAFCPTED",26,0) ;. D ADDRESS^RGRSBULL(DGDFN,$G(@ARRAY@(.01)),$G(@ARRAY@(.111)),$G(@ARRAY@(.112)),$G(@ARRAY@(.113)),@ARRAY@("SENDING SITE"),$G(@ARRAY@(.114)),$G(@ARRAY@(.117)),$G(@ARRAY@(.115)),$G(@ARRAY@(.1112))) "RTN","VAFCPTED",27,0) ; "RTN","VAFCPTED",28,0) I LOCKFLE L -^DPT(DGDFN) "RTN","VAFCPTED",29,0) ; "RTN","VAFCPTED",30,0) K DIE,DA "RTN","VAFCPTED",31,0) Q "RTN","VAFCPTED",32,0) ; "RTN","VAFCPTED",33,0) LOAD ; -- Loads fields to patient file "RTN","VAFCPTED",34,0) N DR,DIE "RTN","VAFCPTED",35,0) ;**756 check if updating ALIAS "RTN","VAFCPTED",36,0) I FLD=1 D Q "RTN","VAFCPTED",37,0) . ;**974,Story 841921 (mko): If flag is not set, compare and update the Alias .01; "RTN","VAFCPTED",38,0) . ; If the flag is set, compare and update the Alias Name Components "RTN","VAFCPTED",39,0) . I '$$GETFLAG D ALIAS Q "RTN","VAFCPTED",40,0) . D ALIASNC(ARRAY,DGDFN,.RGER) "RTN","VAFCPTED",41,0) ;**974,Story 841921 (mko): File name components "RTN","VAFCPTED",42,0) I FLD=1.01 D Q "RTN","VAFCPTED",43,0) . N NAME "RTN","VAFCPTED",44,0) . M NAME=@ARRAY@(1.01) "RTN","VAFCPTED",45,0) . D UPDNC(DGDFN,.NAME) "RTN","VAFCPTED",46,0) I FLD=.025 D UPDSEXOR Q ;**1059, VAMPI-11114 (dri) file sexual orientation "RTN","VAFCPTED",47,0) I FLD=.2406 D UPDPRON Q ;**1059, VAMPI-11118 (dri) file pronoun "RTN","VAFCPTED",48,0) S DA=DGDFN,DIE="^DPT(" "RTN","VAFCPTED",49,0) I $G(@ARRAY@(FLD))="" Q "RTN","VAFCPTED",50,0) I $G(@ARRAY@(FLD))["@" S @ARRAY@(FLD)="@" "RTN","VAFCPTED",51,0) I $G(@ARRAY@(FLD))[U Q "RTN","VAFCPTED",52,0) S DR=FLD_"///^S X=$G(@ARRAY@(FLD))" "RTN","VAFCPTED",53,0) D ^DIE "RTN","VAFCPTED",54,0) Q "RTN","VAFCPTED",55,0) ; "RTN","VAFCPTED",56,0) UPDNC(DGDFN,NAME) ; "RTN","VAFCPTED",57,0) N FDA,IEN,MSG,DIERR "RTN","VAFCPTED",58,0) ;Call updater to add or edit entry in Name Component file "RTN","VAFCPTED",59,0) S FDA(20,"?+1,",.01)=2 "RTN","VAFCPTED",60,0) S FDA(20,"?+1,",.02)=.01 "RTN","VAFCPTED",61,0) S FDA(20,"?+1,",.03)=DGDFN_"," "RTN","VAFCPTED",62,0) S:$D(NAME("FAMILY"))#2 FDA(20,"?+1,",1)=NAME("FAMILY") "RTN","VAFCPTED",63,0) S:$D(NAME("GIVEN"))#2 FDA(20,"?+1,",2)=NAME("GIVEN") "RTN","VAFCPTED",64,0) S:$D(NAME("MIDDLE"))#2 FDA(20,"?+1,",3)=NAME("MIDDLE") "RTN","VAFCPTED",65,0) S:$D(NAME("SUFFIX"))#2 FDA(20,"?+1,",5)=NAME("SUFFIX") "RTN","VAFCPTED",66,0) D UPDATE^DIE("K","FDA","IEN","MSG") "RTN","VAFCPTED",67,0) Q "RTN","VAFCPTED",68,0) ; "RTN","VAFCPTED",69,0) ALIAS ;update Alias multiple **756 "RTN","VAFCPTED",70,0) ;allow the synchronizing of the Alias multiple with the data passed in the array "RTN","VAFCPTED",71,0) ;array(1,x)=name (last, first middle suffix format)^ssn "RTN","VAFCPTED",72,0) N HAVE,I,MIEN,ADD,DONE,FDA,MPIFERR,DEL,ALIAS,CNT,DGALIAS "RTN","VAFCPTED",73,0) M HAVE=^DPT(DGDFN,.01) "RTN","VAFCPTED",74,0) S CNT=0 "RTN","VAFCPTED",75,0) ;see if any need to be added "RTN","VAFCPTED",76,0) S I=0 F S I=$O(@ARRAY@(1,I)) Q:'I D ;loop through incoming data "RTN","VAFCPTED",77,0) .S ADD=1,(DONE,MIEN)=0 F S MIEN=$O(HAVE(MIEN)) Q:'MIEN D I DONE Q ;loop through existing data "RTN","VAFCPTED",78,0) ..I $P(@ARRAY@(1,I),"^",1,2)=$P($G(HAVE(MIEN,0)),"^",1,2) S ADD=0,DONE=1 Q ;compare to existing data to see if already in subfile, if not then "RTN","VAFCPTED",79,0) .I ADD S ALIAS=@ARRAY@(1,I) D ;add new entry to subfile "RTN","VAFCPTED",80,0) ..S FDA(2.01,"+"_I_","_DGDFN_",",.01)=$P(@ARRAY@(1,I),"^") "RTN","VAFCPTED",81,0) ..S FDA(2.01,"+"_I_","_DGDFN_",",1)=$P(@ARRAY@(1,I),"^",2) "RTN","VAFCPTED",82,0) I $D(FDA) D UPDATE^DIE("E","FDA",,"MPIFERR") I $G(MPIFERR("DIERR",1,"TEXT",1))'="" S RGER="-1^"_MPIFERR("DIERR",1,"TEXT",1) "RTN","VAFCPTED",83,0) ;delete entries "RTN","VAFCPTED",84,0) K FDA,MPIFERR "RTN","VAFCPTED",85,0) S MIEN=0 F S MIEN=$O(HAVE(MIEN)) Q:'MIEN D ;loop through existing data "RTN","VAFCPTED",86,0) . ; **837,MVI_805 check for duplicates (name + ssn combination) "RTN","VAFCPTED",87,0) . S HAVE=$P($G(HAVE(MIEN,0)),"^",1,2) "RTN","VAFCPTED",88,0) . X $S(HAVE="":"",$D(DGALIAS(HAVE)):"S FDA(2.01,MIEN_"",""_DGDFN_"","",.01)=""@"" Q",1:"S DGALIAS(HAVE)=HAVE") "RTN","VAFCPTED",89,0) . ; "RTN","VAFCPTED",90,0) . S DEL=1,(DONE,I)=0 F S I=$O(@ARRAY@(1,I)) Q:'I D I DONE Q ;loop through incoming data "RTN","VAFCPTED",91,0) . . I HAVE=$P(@ARRAY@(1,I),"^",1,2) S DEL=0,DONE=1 Q ;compare to existing data to see if data should be deleted "RTN","VAFCPTED",92,0) . I DEL S FDA(2.01,MIEN_","_DGDFN_",",.01)="@" ;existing entry to delete "RTN","VAFCPTED",93,0) I $D(FDA) D FILE^DIE("E","FDA","MPIERR") I $G(MPIFERR("DIERR",1,"TEXT",1))'="" S RGER="-1^"_MPIFERR("DIERR",1,"TEXT",1) ;delete entry "RTN","VAFCPTED",94,0) Q "RTN","VAFCPTED",95,0) ; "RTN","VAFCPTED",96,0) ALIASNC(ARRAY,DGDFN,RGER) ;Compare incoming Alias Name Components with existing Alias Name Components and add or delete as necessary "RTN","VAFCPTED",97,0) ;**974,Story 841921 (mko): New subroutine "RTN","VAFCPTED",98,0) N FDA,HAVE,IEN,IENROOT,IN,NC,NCIEN,NCIENS,ORIG,SEQ,SUB "RTN","VAFCPTED",99,0) ; "RTN","VAFCPTED",100,0) ;Create IN("surname^firstname^middlename^suffix^ssn",seq#)="" from incoming data "RTN","VAFCPTED",101,0) S SEQ=0 F S SEQ=$O(@ARRAY@(1,SEQ)) Q:'SEQ D "RTN","VAFCPTED",102,0) . S IN(@ARRAY@(1,SEQ,"NC")_"^"_$P(@ARRAY@(1,SEQ),"^",2),SEQ)="" "RTN","VAFCPTED",103,0) ; "RTN","VAFCPTED",104,0) ;Create ORIG("surname^firstname^middlename^suffix^ssn",subien)="" from existing data "RTN","VAFCPTED",105,0) M HAVE=^DPT(DGDFN,.01) "RTN","VAFCPTED",106,0) S IEN=0 F S IEN=$O(HAVE(IEN)) Q:'IEN D "RTN","VAFCPTED",107,0) . S NCIEN=$P(HAVE(IEN,0),"^",3) "RTN","VAFCPTED",108,0) . D:$P(HAVE(IEN,0),"^",3)>0 "RTN","VAFCPTED",109,0) .. S NC=$G(^VA(20,NCIEN,1)) "RTN","VAFCPTED",110,0) .. S SUB=$P(NC,"^",1,3)_"^"_$P(NC,"^",5)_"^"_$P(HAVE(IEN,0),"^",2) "RTN","VAFCPTED",111,0) .. ;If this is a duplicate, set the FDA for deletion here "RTN","VAFCPTED",112,0) .. S:$D(ORIG(SUB)) FDA(2.01,IEN_","_DGDFN_",",.01)="@" "RTN","VAFCPTED",113,0) .. S ORIG(SUB,IEN)="" "RTN","VAFCPTED",114,0) ; "RTN","VAFCPTED",115,0) ;Loop through ORIG to delete Aliases that aren't in IN array "RTN","VAFCPTED",116,0) S SUB="" F S SUB=$O(ORIG(SUB)) Q:SUB="" D "RTN","VAFCPTED",117,0) . D:'$D(IN(SUB)) "RTN","VAFCPTED",118,0) .. S IEN=$O(ORIG(SUB,0)) Q:'IEN "RTN","VAFCPTED",119,0) .. S FDA(2.01,IEN_","_DGDFN_",",.01)="@" "RTN","VAFCPTED",120,0) D:$D(FDA) "RTN","VAFCPTED",121,0) . D FILE^DIE("E","FDA","MSG") K FDA "RTN","VAFCPTED",122,0) . I $G(DIERR) S RGER="-1^"_$$BLDERR("MSG") K MSG "RTN","VAFCPTED",123,0) ; "RTN","VAFCPTED",124,0) ;Loop through IN and add Aliases that aren't in ORIG array; we need to add the Alias, before the Name Components entry can be updated "RTN","VAFCPTED",125,0) S SUB="" F S SUB=$O(IN(SUB)) Q:SUB="" D "RTN","VAFCPTED",126,0) . D:'$D(ORIG(SUB)) "RTN","VAFCPTED",127,0) .. S SEQ=$O(IN(SUB,0)) "RTN","VAFCPTED",128,0) .. S FDA(2.01,"+"_SEQ_","_DGDFN_",",.01)=$$FMTNAME(@ARRAY@(1,SEQ,"NC")) "RTN","VAFCPTED",129,0) .. S FDA(2.01,"+"_SEQ_","_DGDFN_",",1)=$P(@ARRAY@(1,SEQ),"^",2) "RTN","VAFCPTED",130,0) D:$D(FDA) "RTN","VAFCPTED",131,0) . ;Add the Alias and Alias SSN "RTN","VAFCPTED",132,0) . D UPDATE^DIE("E","FDA","IENROOT","MSG") K FDA "RTN","VAFCPTED",133,0) . I $G(DIERR) S RGER="-1^"_$$BLDERR("MSG") K MSG "RTN","VAFCPTED",134,0) . ;For each Alias added, update the corresponding Name Components entry "RTN","VAFCPTED",135,0) . S SEQ=0 F S SEQ=$O(IENROOT(SEQ)) Q:'SEQ D "RTN","VAFCPTED",136,0) .. S IEN=$G(IENROOT(SEQ)) Q:IEN'>0 "RTN","VAFCPTED",137,0) .. S NCIENS=$P($G(^DPT(DGDFN,.01,IEN,0)),"^",3)_"," Q:'NCIENS "RTN","VAFCPTED",138,0) .. S NC=$G(@ARRAY@(1,SEQ,"NC")) "RTN","VAFCPTED",139,0) .. S FDA(20,NCIENS,1)=$P(NC,"^") "RTN","VAFCPTED",140,0) .. S FDA(20,NCIENS,2)=$P(NC,"^",2) "RTN","VAFCPTED",141,0) .. S FDA(20,NCIENS,3)=$P(NC,"^",3) "RTN","VAFCPTED",142,0) .. S FDA(20,NCIENS,5)=$P(NC,"^",4) "RTN","VAFCPTED",143,0) .. D FILE^DIE("E","FDA","MSG") K FDA "RTN","VAFCPTED",144,0) .. I $G(DIERR) S RGER="-1^"_$$BLDERR("MSG") K MSG "RTN","VAFCPTED",145,0) Q "RTN","VAFCPTED",146,0) ; "RTN","VAFCPTED",147,0) BLDERR(MSGROOT) ;Build an error from the error message array "RTN","VAFCPTED",148,0) ;**974,Story 841921 (mko): New subroutine "RTN","VAFCPTED",149,0) N ERRARR,ERRMSG,I "RTN","VAFCPTED",150,0) D MSG^DIALOG("AE",.ERRARR,"","",MSGROOT) "RTN","VAFCPTED",151,0) S ERRMSG="",I=0 F S I=$O(ERRARR(I)) Q:'I S ERRMSG=ERRMSG_$S(ERRMSG]"":" ",1:"")_$G(ERRARR(I)) "RTN","VAFCPTED",152,0) Q ERRMSG "RTN","VAFCPTED",153,0) ; "RTN","VAFCPTED",154,0) FMTNAME(ARRAY,LEN) ;Return a formatted name from cleaned Name Components that doesn't exceed LEN characters in length. "RTN","VAFCPTED",155,0) ;**974,Story 841921 (mko): New function (duplicate of FMTNAME^RGADTP3) "RTN","VAFCPTED",156,0) N NC "RTN","VAFCPTED",157,0) S:'$G(LEN) LEN=30 "RTN","VAFCPTED",158,0) ; "RTN","VAFCPTED",159,0) ;If ARRAY is passed as a string and doesn't have descendants assume it equals "surname^first^middle^suffix" "RTN","VAFCPTED",160,0) D:$D(ARRAY)=1 "RTN","VAFCPTED",161,0) . S ARRAY("SURNAME")=$P(ARRAY,"^") "RTN","VAFCPTED",162,0) . S ARRAY("FIRST")=$P(ARRAY,"^",2) "RTN","VAFCPTED",163,0) . S ARRAY("MIDDLE")=$P(ARRAY,"^",3) "RTN","VAFCPTED",164,0) . S ARRAY("SUFFIX")=$P(ARRAY,"^",4) "RTN","VAFCPTED",165,0) ; "RTN","VAFCPTED",166,0) ;Clean the components "RTN","VAFCPTED",167,0) S NC("FAMILY")=$$CLEANC^XLFNAME($G(ARRAY("SURNAME"))) "RTN","VAFCPTED",168,0) S NC("GIVEN")=$$CLEANC^XLFNAME($G(ARRAY("FIRST"))) "RTN","VAFCPTED",169,0) S NC("MIDDLE")=$$CLEANC^XLFNAME($G(ARRAY("MIDDLE"))) "RTN","VAFCPTED",170,0) S NC("SUFFIX")=$$CLEANC^XLFNAME($G(ARRAY("SUFFIX"))) "RTN","VAFCPTED",171,0) ; "RTN","VAFCPTED",172,0) ;Build a full name, maximum length LEN "RTN","VAFCPTED",173,0) Q $$NAMEFMT^XLFNAME(.NC,"F","CL"_LEN) "RTN","VAFCPTED",174,0) ; "RTN","VAFCPTED",175,0) GETFLAG() ;Get the value of the name components flag "RTN","VAFCPTED",176,0) ;**974,Story 841921 (mko): New function "RTN","VAFCPTED",177,0) I $T(GETFLAG^MPIFNAMC)]"" Q $$GETFLAG^MPIFNAMC "RTN","VAFCPTED",178,0) Q 0 "RTN","VAFCPTED",179,0) ; "RTN","VAFCPTED",180,0) UPDSEXOR ;**1059, VAMPI-11114 (dri) update Sexual Orientation multiple "RTN","VAFCPTED",181,0) N CUR,FDA,I,INC,SOCODE,SOIEN,VAFCERR "RTN","VAFCPTED",182,0) I $G(@ARRAY@(.025,1))["@" S @ARRAY@(.025,1)="@" ;change "@" to @, since no so's received in obx's delete all so's at the vista "RTN","VAFCPTED",183,0) I $G(@ARRAY@(.025,1))'="@" S I=0 F S I=$O(@ARRAY@(.025,I)) Q:'I S SOCODE=$P($G(@ARRAY@(.025,I)),"^",1) I SOCODE'="",(SOCODE'["@"),(SOCODE'="""""") S INC(SOCODE)=I ;incoming values "RTN","VAFCPTED",184,0) S I=0 F S I=$O(^DPT(DGDFN,.025,I)) Q:'I S SOIEN=+$P($G(^(I,0)),"^",1),SOCODE=$P($G(^DG(47.77,SOIEN,0)),"^",2) I SOCODE'="" S CUR(SOCODE)=I ;current/local vista so's "RTN","VAFCPTED",185,0) ; "RTN","VAFCPTED",186,0) ;loop through incoming so's and add if not in vista "RTN","VAFCPTED",187,0) S SOCODE="" F S SOCODE=$O(INC(SOCODE)) Q:SOCODE="" I '$D(CUR(SOCODE)) S FDA(2.025,"+"_INC(SOCODE)_","_DGDFN_",",.01)=SOCODE "RTN","VAFCPTED",188,0) ; "RTN","VAFCPTED",189,0) ;loop through vista and delete if not in incoming so's "RTN","VAFCPTED",190,0) S SOCODE="" F S SOCODE=$O(CUR(SOCODE)) Q:SOCODE="" I '$D(INC(SOCODE)) S FDA(2.025,CUR(SOCODE)_","_DGDFN_",",.01)="@" "RTN","VAFCPTED",191,0) ; "RTN","VAFCPTED",192,0) I $D(FDA) D UPDATE^DIE("E","FDA",,"VAFCERR") I $G(VAFCERR("DIERR",1,"TEXT",1))'="" S RGER="-1^"_VAFCERR("DIERR",1,"TEXT",1) "RTN","VAFCPTED",193,0) Q "RTN","VAFCPTED",194,0) ; "RTN","VAFCPTED",195,0) UPDPRON ;**1059, VAMPI-11118 (dri) update Pronoun multiple "RTN","VAFCPTED",196,0) N CUR,FDA,I,INC,PRCODE,PRIEN,VAFCERR "RTN","VAFCPTED",197,0) I $G(@ARRAY@(.2406,1))["@" S @ARRAY@(.2406,1)="@" ;change "@" to @, since no so's received in obx's delete all so's at the vista "RTN","VAFCPTED",198,0) I $G(@ARRAY@(.2406,1))'="@" S I=0 F S I=$O(@ARRAY@(.2406,I)) Q:'I S PRCODE=$P($G(@ARRAY@(.2406,I)),"^",1) I PRCODE'="",(PRCODE'["@"),(PRCODE'="""""") S INC(PRCODE)=I ;incoming values "RTN","VAFCPTED",199,0) S I=0 F S I=$O(^DPT(DGDFN,.2406,I)) Q:'I S PRIEN=+$P($G(^(I,0)),"^",1),PRCODE=$P($G(^DG(47.78,PRIEN,0)),"^",2) I PRCODE'="" S CUR(PRCODE)=I ;current/local vista so's "RTN","VAFCPTED",200,0) ; "RTN","VAFCPTED",201,0) ;loop through incoming so's and add if not in vista "RTN","VAFCPTED",202,0) S PRCODE="" F S PRCODE=$O(INC(PRCODE)) Q:PRCODE="" I '$D(CUR(PRCODE)) S FDA(2.2406,"+"_INC(PRCODE)_","_DGDFN_",",.01)=PRCODE "RTN","VAFCPTED",203,0) ; "RTN","VAFCPTED",204,0) ;loop through vista and delete if not in incoming so's "RTN","VAFCPTED",205,0) S PRCODE="" F S PRCODE=$O(CUR(PRCODE)) Q:PRCODE="" I '$D(INC(PRCODE)) S FDA(2.2406,CUR(PRCODE)_","_DGDFN_",",.01)="@" "RTN","VAFCPTED",206,0) ; "RTN","VAFCPTED",207,0) I $D(FDA) D UPDATE^DIE("E","FDA",,"VAFCERR") I $G(VAFCERR("DIERR",1,"TEXT",1))'="" S RGER="-1^"_VAFCERR("DIERR",1,"TEXT",1) "RTN","VAFCPTED",208,0) Q "RTN","VAFCPTED",209,0) ; "RTN","VAFCQRY") 0^7^B34739749^B27513336 "RTN","VAFCQRY",1,0) VAFCQRY ;BIR/DLR-Query for patient demographics ;7/16/21 11:39 "RTN","VAFCQRY",2,0) ;;5.3;Registration;**428,575,627,707,863,902,926,967,1059**;Aug 13, 1993;Build 6 "RTN","VAFCQRY",3,0) ; "RTN","VAFCQRY",4,0) IN ;process in the patient query "RTN","VAFCQRY",5,0) N IEN,HLA,VAFCCNT,ICN,CLAIM,SG,VAFCER,VAFC,DFN,STATE,CITY,SUBCOMP,COMP,REP,LVL,LVL2,VAFC,SSN,SAVEDFN "RTN","VAFCQRY",6,0) S VAFCCNT=1,VAFCER=1 "RTN","VAFCQRY",7,0) F VAFC=1:1 X HLNEXT Q:HLQUIT'>0 S SG=$E(HLNODE,1,3) D:$T(@SG)]"" @SG "RTN","VAFCQRY",8,0) S SAVEDFN=$G(DFN) "RTN","VAFCQRY",9,0) D CHKID^VAFCQRY2(.ICN,.SSN,.DFN) "RTN","VAFCQRY",10,0) I $G(DFN)'>0 D "RTN","VAFCQRY",11,0) . ;**863 MVI_2352 if merged send back merged record info for update "RTN","VAFCQRY",12,0) . I SAVEDFN,$D(^DPT(SAVEDFN,-9)) D Q "RTN","VAFCQRY",13,0) .. N DFN,ICN "RTN","VAFCQRY",14,0) .. S DFN=^DPT(SAVEDFN,-9),ICN=$$GETICN^MPIF001(+DFN) "RTN","VAFCQRY",15,0) .. S VAFCER="-1^New Primary record "_DFN_" at site with ICN "_ICN "RTN","VAFCQRY",16,0) . S VAFCER="-1^Unknown ICN#"_$G(ICN)_" and SSN#"_$G(SSN) "RTN","VAFCQRY",17,0) S ^TMP("HLA",$J,VAFCCNT)="MSA"_HL("FS")_"AA"_HL("FS")_HL("MID")_HL("FS")_$S(+$G(VAFCER)'>0:$P(VAFCER,"^",2),1:""),VAFCCNT=VAFCCNT+1 "RTN","VAFCQRY",18,0) S ^TMP("HLA",$J,VAFCCNT)=VAFCQRD,VAFCCNT=VAFCCNT+1 "RTN","VAFCQRY",19,0) I $G(VAFCER)>0 D BLDRSP(DFN,.VAFCCNT) "RTN","VAFCQRY",20,0) D LINK^HLUTIL3(SITE,.VAFC) S IEN=$O(VAFC(0)) S HLL("LINKS",1)="^"_VAFC(IEN) "RTN","VAFCQRY",21,0) D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.HLRESLTA,"",.HL) "RTN","VAFCQRY",22,0) K VAFCER,VAFCID,COMP,SITE,VAFCFS,VAFCRCV,VAFCQRD,^TMP("HLA",$J) "RTN","VAFCQRY",23,0) Q "RTN","VAFCQRY",24,0) ; "RTN","VAFCQRY",25,0) RESP ;Response processing initiated from the MPI. "RTN","VAFCQRY",26,0) Q "RTN","VAFCQRY",27,0) ; "RTN","VAFCQRY",28,0) ROUTE ;Routine logic initiated from the MPI. "RTN","VAFCQRY",29,0) Q "RTN","VAFCQRY",30,0) ; "RTN","VAFCQRY",31,0) BLDRSP(DFN,VAFCCNT) ; "RTN","VAFCQRY",32,0) N EVN,PID,PD1,SEQ,ERR,CNT,X,PV2,RADE,LABE,PRES "RTN","VAFCQRY",33,0) N SIDG,ZEL,ZSP,NAMECOMP,OLD,PV1,DODF,DODD,DODOPT,DODNP,DODDISDT,SECLVL,SEXOR,SEXORD,PRON,PROND "RTN","VAFCQRY",34,0) ;construct EVN (for TF Event Type AND Last Treatment Date) "RTN","VAFCQRY",35,0) S SEQ="1,2" D BLDEVN(DFN,.SEQ,.EVN,.HL,"A19",.ERR) S ^TMP("HLA",$J,VAFCCNT)=EVN(1) S VAFCCNT=VAFCCNT+1 "RTN","VAFCQRY",36,0) ;construct PID "RTN","VAFCQRY",37,0) S SEQ="ALL" D BLDPID(DFN,1,.SEQ,.PID,.HL,.ERR) S ^TMP("HLA",$J,VAFCCNT)=PID(1) S X=1,CNT=1 F S X=$O(PID(X)) Q:'X I $D(PID(X)) S ^TMP("HLA",$J,VAFCCNT,CNT)=PID(X),CNT=CNT+1 "RTN","VAFCQRY",38,0) S VAFCCNT=VAFCCNT+1 "RTN","VAFCQRY",39,0) ;construct PD1 **707 "RTN","VAFCQRY",40,0) ;S SEQ="3" D BLDPD1(DFN,.SEQ,.PD1,.HL,.ERR) S ^TMP("HLA",$J,VAFCCNT)=PD1(1) "RTN","VAFCQRY",41,0) S PD1=$$PD1^VAFCSB I PD1'="" S ^TMP("HLA",$J,VAFCCNT)=PD1,VAFCCNT=VAFCCNT+1 ;**707 "RTN","VAFCQRY",42,0) S PV1=$$PV1^VAFCSB I PV1'="" S ^TMP("HLA",$J,VAFCCNT)=PV1,VAFCCNT=VAFCCNT+1 ;**707 "RTN","VAFCQRY",43,0) S PV2=$$PV2^VAFCSB I PV2'="" S ^TMP("HLA",$J,VAFCCNT)=PV2,VAFCCNT=VAFCCNT+1 ;**707 "RTN","VAFCQRY",44,0) S PRES=$$PHARA^VAFCSB I PRES'="" S ^TMP("HLA",$J,VAFCCNT)=PRES,VAFCCNT=VAFCCNT+1 ;**707 "RTN","VAFCQRY",45,0) S LABE=$$LABE^VAFCSB I LABE'="" S ^TMP("HLA",$J,VAFCCNT)=LABE,VAFCCNT=VAFCCNT+1 ;**707 "RTN","VAFCQRY",46,0) S RADE=$$RADE^VAFCSB I RADE'="" S ^TMP("HLA",$J,VAFCCNT)=RADE,VAFCCNT=VAFCCNT+1 ;**707 "RTN","VAFCQRY",47,0) S SIDG=$$SIG^VAFCSB(DFN) I $G(SIDG)'="" S ^TMP("HLA",$J,VAFCCNT)=SIDG,VAFCCNT=VAFCCNT+1 ;**902 MVI_4634 (ckn) - OBX FOR SELF ID GENDER "RTN","VAFCQRY",48,0) S NAMECOMP=$$NAMEOBX^VAFCSB(DFN) I $G(NAMECOMP)'="" S ^TMP("HLA",$J,VAFCCNT)=NAMECOMP,VAFCCNT=VAFCCNT+1 ;**902 MVI_4634 (ckn): OBX for Patient .01 and Name Components "RTN","VAFCQRY",49,0) S OLD=$$OLD(DFN) I $G(OLD)'="" S ^TMP("HLA",$J,VAFCCNT)=OLD,VAFCCNT=VAFCCNT+1 ;**902 MVI_4634 (ckn) - OBX to mark and Older record "RTN","VAFCQRY",50,0) S DODF=$$DODF^VAFCSB(DFN) I $G(DODF)'="" S ^TMP("HLA",$J,VAFCCNT)=DODF,VAFCCNT=VAFCCNT+1 ;**902 MVI_4898 (ckn) : OBX for DOD fields "RTN","VAFCQRY",51,0) ;**926 Story 3230009 (ckn) : OBX for Additional DOD fields "RTN","VAFCQRY",52,0) S DODD=$$DODD^VAFCSB(DFN) I $G(DODD)'="" S ^TMP("HLA",$J,VAFCCNT)=DODD,VAFCCNT=VAFCCNT+1 ;Date of Death Documents "RTN","VAFCQRY",53,0) S DODOPT=$$DODOPT^VAFCSB(DFN) I $G(DODOPT)'="" S ^TMP("HLA",$J,VAFCCNT)=DODOPT,VAFCCNT=VAFCCNT+1 ;Date of Death Option "RTN","VAFCQRY",54,0) S DODNP=$$DODNTPRV^VAFCSB(DFN) I $G(DODNP)'="" S ^TMP("HLA",$J,VAFCCNT)=DODNP,VAFCCNT=VAFCCNT+1 ;Date Of Death Notify Provider "RTN","VAFCQRY",55,0) ;**967 - Story 783361 (ckn) - OBX for Security Level "RTN","VAFCQRY",56,0) S SECLVL=$$SECLOG^VAFCSB(DFN) I $G(SECLVL)'="" S ^TMP("HLA",$J,VAFCCNT)=SECLVL,VAFCCNT=VAFCCNT+1 "RTN","VAFCQRY",57,0) D SEXOR^VAFCSB(DFN,.SEXOR) I $O(SEXOR(0)) N CNT S CNT=0 F S CNT=$O(SEXOR(CNT)) Q:'CNT S HLA("HLS",EN)=SEXOR(CNT),EN=EN+1 ;**1059, VAMPI-11114 (dri) "RTN","VAFCQRY",58,0) D SEXORD^VAFCSB(DFN,.SEXORD) I $O(SEXORD(0)) D S EN=EN+1 ;**1059, VAMPI-11114 (dri) "RTN","VAFCQRY",59,0) .N CNT,LVL "RTN","VAFCQRY",60,0) .S LVL=1,CNT=0 F S CNT=$O(SEXORD(CNT)) Q:'CNT D "RTN","VAFCQRY",61,0) ..I CNT=1 S HLA("HLS",EN)=SEXORD(CNT) "RTN","VAFCQRY",62,0) ..I CNT>1 S HLA("HLS",EN,LVL)=SEXORD(CNT),LVL=LVL+1 "RTN","VAFCQRY",63,0) D PRON^VAFCSB(DFN,.PRON) I $O(PRON(0)) N CNT S CNT=0 F S CNT=$O(PRON(CNT)) Q:'CNT S HLA("HLS",EN)=PRON(CNT),EN=EN+1 ;**1059, VAMPI-11118 (dri) "RTN","VAFCQRY",64,0) D PROND^VAFCSB(DFN,.PROND) I $O(PROND(0)) D S EN=EN+1 ;**1059, VAMPI-11118 (dri) "RTN","VAFCQRY",65,0) .N CNT,LVL "RTN","VAFCQRY",66,0) .S LVL=1,CNT=0 F S CNT=$O(PROND(CNT)) Q:'CNT D "RTN","VAFCQRY",67,0) ..I CNT=1 S HLA("HLS",EN)=PROND(CNT) "RTN","VAFCQRY",68,0) ..I CNT>1 S HLA("HLS",EN,LVL)=PROND(CNT),LVL=LVL+1 "RTN","VAFCQRY",69,0) ;construct ZPD segment "RTN","VAFCQRY",70,0) S SEQ="1,17,21,34" ;**707 Added 1, 21 and 34 to ZPD fields "RTN","VAFCQRY",71,0) S ^TMP("HLA",$J,VAFCCNT)=$$EN1^VAFHLZPD(DFN,SEQ) "RTN","VAFCQRY",72,0) S VAFCCNT=VAFCCNT+1 "RTN","VAFCQRY",73,0) ;**902 MVI_4634 (ckn) - Add ZSP and ZEL segments "RTN","VAFCQRY",74,0) S ZSP=$$EN^VAFHLZSP(DFN) I $G(ZSP)'="" S ^TMP("HLA",$J,VAFCCNT)=ZSP,VAFCCNT=VAFCCNT+1 ;ZSP segment "RTN","VAFCQRY",75,0) S ZEL=$$EN^VAFHLZEL(DFN,"1,8,9",1) I $G(ZEL)'="" S ^TMP("HLA",$J,VAFCCNT)=ZEL,VAFCCNT=VAFCCNT+1 ;ZEL segment "RTN","VAFCQRY",76,0) Q "RTN","VAFCQRY",77,0) ; "RTN","VAFCQRY",78,0) MSH ;process MSH segment "RTN","VAFCQRY",79,0) S VAFCFS=HL("FS") "RTN","VAFCQRY",80,0) S HLQ=HL("Q"),HLFS=HL("FS"),HLECH=HL("ECH") "RTN","VAFCQRY",81,0) S VAFCID=HL("MID") "RTN","VAFCQRY",82,0) S COMP=$E(HL("ECH"),1) "RTN","VAFCQRY",83,0) S REP=$E(HL("ECH"),2) "RTN","VAFCQRY",84,0) S SUBCOMP=$E(HL("ECH"),4) "RTN","VAFCQRY",85,0) S SITE=$$LKUP^XUAF4($P($P(HLNODE,HL("FS"),4),COMP)) "RTN","VAFCQRY",86,0) Q "RTN","VAFCQRY",87,0) ; "RTN","VAFCQRY",88,0) QRD ;process QRD segment "RTN","VAFCQRY",89,0) N QRD,X,IDS,WSF,ID,QRDAA,QRDNTC "RTN","VAFCQRY",90,0) S VAFCQRD=HLNODE "RTN","VAFCQRY",91,0) S VAFCRCV=$P(VAFCQRD,HL("FS"),5) "RTN","VAFCQRY",92,0) S IDS=$P(VAFCQRD,HL("FS"),9) "RTN","VAFCQRY",93,0) F X=1:1:$L(IDS,REP) S WSF=$P(IDS,REP,X) D "RTN","VAFCQRY",94,0) . ;get id, assigning authority, and name type code "RTN","VAFCQRY",95,0) . S ID=$P(WSF,COMP),QRDAA=$P($P(WSF,COMP,9),SUBCOMP),QRDNTC=$P(WSF,COMP,10) "RTN","VAFCQRY",96,0) . ;check assigning authority(0363) AND name type code(0203) "RTN","VAFCQRY",97,0) . I QRDAA="USVHA" D "RTN","VAFCQRY",98,0) .. I QRDNTC="NI" S ICN=ID ;National unique individual identifier "RTN","VAFCQRY",99,0) .. I QRDNTC="PI" S DFN=ID ;Patient internal identifier "RTN","VAFCQRY",100,0) . I QRDAA="USSSA" D "RTN","VAFCQRY",101,0) .. I QRDNTC="SS" S SSN=ID ;Social Security number "RTN","VAFCQRY",102,0) Q "RTN","VAFCQRY",103,0) ; "RTN","VAFCQRY",104,0) BLDEVN(DFN,SEQ,EVN,HL,EVR,ERR) ;build EVN for TF last treatment date and event reason "RTN","VAFCQRY",105,0) ; At this point only sequence one and two are supported "RTN","VAFCQRY",106,0) ; Variable list "RTN","VAFCQRY",107,0) ; DFN - internal PATIENT (#2) number "RTN","VAFCQRY",108,0) ; SEQ - variable consisting of sequence numbers delimited by commas "RTN","VAFCQRY",109,0) ; that will be used to build the message "RTN","VAFCQRY",110,0) ; EVN (passed by reference) - array location to place EVN segment result, the array can have existing values when passed. "RTN","VAFCQRY",111,0) ; HL - array that contains the necessary HL variables (init^hlsub) "RTN","VAFCQRY",112,0) ; EVR - event reason that triggered this message "RTN","VAFCQRY",113,0) ; ERR - array that is used to return an error "RTN","VAFCQRY",114,0) ; "RTN","VAFCQRY",115,0) D BLDEVN^VAFCQRY2(DFN,SEQ,.EVN,.HL,EVR,.ERR) "RTN","VAFCQRY",116,0) Q "RTN","VAFCQRY",117,0) ; "RTN","VAFCQRY",118,0) BLDPD1(DFN,SEQ,PD1,HL,ERR) ; "RTN","VAFCQRY",119,0) ; At this point only sequence 3 is supported "RTN","VAFCQRY",120,0) ; Variable list "RTN","VAFCQRY",121,0) ; DFN - internal PATIENT (#2) number "RTN","VAFCQRY",122,0) ; SEQ - variable consisting of sequence numbers delimited by commas "RTN","VAFCQRY",123,0) ; that will be used to build the message "RTN","VAFCQRY",124,0) ; PD1 (passed by reference) - array location to place PD1 segment result, the array can have existing values when passed. "RTN","VAFCQRY",125,0) ; HL - array that contains the necessary HL variables (init^hlsub) "RTN","VAFCQRY",126,0) ; ERR - array that is used to return an error "RTN","VAFCQRY",127,0) ; "RTN","VAFCQRY",128,0) D BLDPD1^VAFCQRY2(DFN,SEQ,.PD1,.HL,.ERR) "RTN","VAFCQRY",129,0) Q "RTN","VAFCQRY",130,0) ; "RTN","VAFCQRY",131,0) BLDPID(DFN,CNT,SEQ,PID,HL,ERR) ;build PID from File #2 "RTN","VAFCQRY",132,0) ;The required sequences 3 and 5 will be returned and at this point "RTN","VAFCQRY",133,0) ;sequences 1-3,5-8,10-14,16,17,19,22-24 and 29 are supported "RTN","VAFCQRY",134,0) ; "RTN","VAFCQRY",135,0) ; At this point only sequence one and two are supported "RTN","VAFCQRY",136,0) ; Variable list "RTN","VAFCQRY",137,0) ; DFN - internal PATIENT (#2) number "RTN","VAFCQRY",138,0) ; CNT - value to be place in PID seq#1 (SET ID) "RTN","VAFCQRY",139,0) ; SEQ - variable consisting of sequence numbers delimited by commas "RTN","VAFCQRY",140,0) ; that will be used to build the message "RTN","VAFCQRY",141,0) ; PID (passed by reference) - array location to place PID segment "RTN","VAFCQRY",142,0) ; result, the array can have existing values when passed. "RTN","VAFCQRY",143,0) ; HL - array that contains the necessary HL variables (init^hlsub) "RTN","VAFCQRY",144,0) ; ERR - array that is used to return an error "RTN","VAFCQRY",145,0) ; "RTN","VAFCQRY",146,0) ;if this is a mismatch a null or """" should be passed in, so that "RTN","VAFCQRY",147,0) ;the ICN will be removed at the site "RTN","VAFCQRY",148,0) ; "RTN","VAFCQRY",149,0) D BLDPID^VAFCQRY1(DFN,CNT,SEQ,.PID,.HL,.ERR) "RTN","VAFCQRY",150,0) Q "RTN","VAFCQRY",151,0) ; "RTN","VAFCQRY",152,0) OLD(DFN) ; **902 MVI_4634 (ckn) Return OBX segment to flag a record as "old" "RTN","VAFCQRY",153,0) Q $S($D(^XTMP("MPIF OLD RECORDS",DFN))#2:"OBX"_HL("FS")_HL("FS")_"CE"_HL("FS")_"OLDER RECORD"_HL("FS")_HL("FS")_"Y",1:"") "RTN","VAFCQRY",154,0) ; "RTN","VAFCQRY1") 0^9^B102699119^B99425329 "RTN","VAFCQRY1",1,0) VAFCQRY1 ;BIR/DLR-Query for patient demographics ;7/19/21 10:44 "RTN","VAFCQRY1",2,0) ;;5.3;Registration;**428,474,477,575,627,648,698,711,707,837,874,937,974,981,1059**;Aug 13, 1993;Build 6 "RTN","VAFCQRY1",3,0) ; "RTN","VAFCQRY1",4,0) ;Reference to $$GETDFNS^MPIF002 supported by IA #3634. "RTN","VAFCQRY1",5,0) ; "RTN","VAFCQRY1",6,0) BLDPID(DFN,CNT,SEQ,PID,HL,ERR) ;build PID from File #2 "RTN","VAFCQRY1",7,0) ; Variable list "RTN","VAFCQRY1",8,0) ; DFN - internal PATIENT (#2) number "RTN","VAFCQRY1",9,0) ; CNT - value to be place in PID seq#1 (SET ID) "RTN","VAFCQRY1",10,0) ; SEQ - variable consisting of sequence numbers delimited by commas "RTN","VAFCQRY1",11,0) ; that will be used to build the message (default is ALL) "RTN","VAFCQRY1",12,0) ; PID (passed by reference) - array location to place PID segment "RTN","VAFCQRY1",13,0) ; result, the array can have existing values when passed. "RTN","VAFCQRY1",14,0) ; HL - array that contains the necessary HL variables (init^hlsub) "RTN","VAFCQRY1",15,0) ; ERR - array that is used to return an error "RTN","VAFCQRY1",16,0) ; "RTN","VAFCQRY1",17,0) ; DG*5.3*981 introduced changes to support the local modifications for HAC/MVI integration in CH*1.3*22529. "RTN","VAFCQRY1",18,0) ; "RTN","VAFCQRY1",19,0) N VAFCMN,VAFCMMN,SITE,VAFCZN,SSN,SITE,APID,HIST,HISTDT,VAFCHMN,NXT,NXTC,COMP,REP,SUBCOMP,STATE,CITY,CLAIM,HLECH,HLFS,HLQ,STATEIEN,SARY,LVL,LNGTH,X,STN,SITA,HLES "RTN","VAFCQRY1",20,0) I '$D(SEQ) S SEQ="ALL" "RTN","VAFCQRY1",21,0) I SEQ="" S SEQ="ALL" "RTN","VAFCQRY1",22,0) I SEQ'="ALL" D "RTN","VAFCQRY1",23,0) .; setting up temp array to hold fields to be included in message "RTN","VAFCQRY1",24,0) .N POS,EN S POS=1 F S EN=$P(SEQ,",",POS) Q:EN="" S SARY(EN)="",POS=POS+1 "RTN","VAFCQRY1",25,0) S HLECH=HL("ECH"),HLFS=HL("FS"),HLQ=HL("Q"),(COMP,HL("COMP"))=$E(HL("ECH"),1) "RTN","VAFCQRY1",26,0) S (SUBCOMP,HL("SUBCOMP"))=$E(HL("ECH"),4),(REP,HL("REP"))=$E(HL("ECH"),2),HLES=$E(HL("ECH"),3) "RTN","VAFCQRY1",27,0) ;get Patient File MPI node "RTN","VAFCQRY1",28,0) S VAFCMN="" "RTN","VAFCQRY1",29,0) N X S X="MPIFAPI" X ^%ZOSF("TEST") I $T S VAFCMN=$$MPINODE^MPIFAPI(DFN) "RTN","VAFCQRY1",30,0) I +VAFCMN<0 S VAFCMN="" "RTN","VAFCQRY1",31,0) S VAFCZN=^DPT(DFN,0),SSN=$P(^DPT(DFN,0),"^",9) "RTN","VAFCQRY1",32,0) ;**974,Story 841921 (mko): Get the internal Alias values instead of external "RTN","VAFCQRY1",33,0) ; so that the internal pointer (IEN) of the Name Components entry can be retrieved. "RTN","VAFCQRY1",34,0) ; In the following code, values are obtained from the "I" nodes instead of the "E" nodes. "RTN","VAFCQRY1",35,0) N VAFCA,VAFCA1 D GETS^DIQ(2,DFN_",","1*","I","VAFCA") ;**698 GETTING ALIAS INFO "RTN","VAFCQRY1",36,0) ;** 707 reformat alias information to include ALIAS SSN in PID-3 with a location reference to the name in PID-5 "RTN","VAFCQRY1",37,0) I $D(VAFCA) N CT,ENT S CT=0,ENT="" F S ENT=$O(VAFCA(2.01,ENT)) Q:ENT="" D "RTN","VAFCQRY1",38,0) .S CT=CT+1 "RTN","VAFCQRY1",39,0) .S VAFCA1(CT,"NAME")=$G(VAFCA(2.01,ENT,.01,"I")) "RTN","VAFCQRY1",40,0) .;I $G(VAFCA(2.01,ENT,1,"E"))'="" S VAFCA1("SSN")="",VAFCA1(CT,"SSN")=$G(VAFCA(2.01,ENT,1,"E")) "RTN","VAFCQRY1",41,0) .S VAFCA1(CT,"SSN")=$G(VAFCA(2.01,ENT,1,"I")) "RTN","VAFCQRY1",42,0) .S VAFCA1(CT,"NCIEN")=$G(VAFCA(2.01,ENT,100.03,"I"))_"^"_ENT ;**974,Story 841921 (mko): Get Name Components pointer and save IENS of Alias subentry "RTN","VAFCQRY1",43,0) ;custom change - if current site is HAC then use station number 741MM - CH*1.3*22529 "RTN","VAFCQRY1",44,0) S SITE=$$SITE^VASITE,STN=$P($$SITE^VASITE,"^",3) I STN=741 S STN="741MM" "RTN","VAFCQRY1",45,0) N TMP F TMP=1:1:31 S APID(TMP)="" "RTN","VAFCQRY1",46,0) S APID(2)=CNT "RTN","VAFCQRY1",47,0) ;list of fields used for backwards compatibility with HDR "RTN","VAFCQRY1",48,0) I $D(SARY(2))!(SEQ="ALL") I VAFCMN'="" S APID(3)=$P(VAFCMN,"^")_"V"_$P(VAFCMN,"^",2) ;Patient ID "RTN","VAFCQRY1",49,0) ;repeat patient ID list including ICN (NI),SSN (SS),CLAIM# (PN) and DFN (PI) "RTN","VAFCQRY1",50,0) I $D(SARY(3))!(SEQ="ALL") D "RTN","VAFCQRY1",51,0) .S APID(4)="" "RTN","VAFCQRY1",52,0) .;National Identifier (ICN) "RTN","VAFCQRY1",53,0) .I VAFCMN'="",+VAFCMN>0 D "RTN","VAFCQRY1",54,0) ..I $E($P(VAFCMN,"^"),1,3)=STN S SITA=STN "RTN","VAFCQRY1",55,0) ..; custom change - if current site is HAC then use station number 741MM - CH*1.3*22529 "RTN","VAFCQRY1",56,0) ..I $E($P(VAFCMN,"^"),1,3)=+STN I +STN="741" S SITA=+STN I SITA=741 S SITA="741MM" "RTN","VAFCQRY1",57,0) ..I $E($P(VAFCMN,"^"),1,3)'=+STN S SITA="200M" ; **707 update assigning authority for national ICNs to 200M for MPI "RTN","VAFCQRY1",58,0) ..S APID(4)=$P(VAFCMN,"^")_"V"_$P(VAFCMN,"^",2)_COMP_COMP_COMP_"USVHA"_SUBCOMP_SUBCOMP_"0363"_COMP_"NI"_COMP_"VA FACILITY ID"_SUBCOMP_SITA_SUBCOMP_"L" D "RTN","VAFCQRY1",59,0) ..;Assumption that if this is a local ICN at this point send the message with an expiration date of today, so that it will be treated as a deprecated ID and stored on the MPI as such "RTN","VAFCQRY1",60,0) ..I $E($P(VAFCMN,"^"),1,3)=STN S APID(4)=APID(4)_COMP_COMP_$$HLDATE^HLFNC(DT,"DT") ;**707 TO ONLY SEND DATE NO TIME "RTN","VAFCQRY1",61,0) .I $G(SSN)'="" S APID(4)=APID(4)_$S(APID(4)'="":REP,1:"")_SSN_COMP_COMP_COMP_"USSSA"_SUBCOMP_SUBCOMP_"0363"_COMP_"SS"_COMP_"VA FACILITY ID"_SUBCOMP_STN_SUBCOMP_"L" "RTN","VAFCQRY1",62,0) .S NXTC=0,LVL=0 ;**837,MVI_879: Move here, so that LVL gets set before pulling in TIN and FIN "RTN","VAFCQRY1",63,0) .;**837,MVI_879: Get TIN and FIN from Patient file and put in PID-3 "RTN","VAFCQRY1",64,0) .;**1059, VAMPI-11120 (dri) Get ITIN from Patient file and put in PID-3 "RTN","VAFCQRY1",65,0) .N TIN,FIN,ITIN,REF "RTN","VAFCQRY1",66,0) .S TIN=$P(VAFCMN,"^",8),FIN=$P(VAFCMN,"^",9),ITIN=$P(VAFCMN,"^",11),REF=$NA(APID(4)) "RTN","VAFCQRY1",67,0) .D ADDLINE($S(TIN="":HLQ,1:TIN)_COMP_COMP_COMP_"USDOD"_SUBCOMP_SUBCOMP_"0363"_COMP_"TIN"_COMP_"VA FACILITY ID"_SUBCOMP_STN_SUBCOMP_"L",.LVL,REF,REP) "RTN","VAFCQRY1",68,0) .D ADDLINE($S(FIN="":HLQ,1:FIN)_COMP_COMP_COMP_"USDOD"_SUBCOMP_SUBCOMP_"0363"_COMP_"FIN"_COMP_"VA FACILITY ID"_SUBCOMP_STN_SUBCOMP_"L",.LVL,REF,REP) "RTN","VAFCQRY1",69,0) .D ADDLINE($S(ITIN="":HLQ,1:ITIN)_COMP_COMP_COMP_"USIRS"_SUBCOMP_SUBCOMP_"0363"_COMP_"NI"_COMP_"VA FACILITY ID"_SUBCOMP_STN_SUBCOMP_"L",.LVL,REF,REP) "RTN","VAFCQRY1",70,0) .I $G(DFN)'="" D "RTN","VAFCQRY1",71,0) ..D ADDLINE(DFN_COMP_COMP_COMP_"USVHA"_SUBCOMP_SUBCOMP_"0363"_COMP_"PI"_COMP_"VA FACILITY ID"_SUBCOMP_STN_SUBCOMP_"L",.LVL,REF,REP) "RTN","VAFCQRY1",72,0) ..;CLAIM# **707 moved dfn and claim number up here since Alias SSN could be many "RTN","VAFCQRY1",73,0) ..I $D(^DPT(DFN,.31)) S CLAIM=$P(^DPT(DFN,.31),"^",3) I +CLAIM>0 D ADDLINE(CLAIM_COMP_COMP_COMP_"USVBA"_SUBCOMP_SUBCOMP_"0363"_COMP_"PN"_COMP_"VA FACILITY ID"_SUBCOMP_STN_SUBCOMP_"L",.LVL,REF,REP) "RTN","VAFCQRY1",74,0) .I $D(VAFCA1) D "RTN","VAFCQRY1",75,0) ..;Have Alias SSNs "RTN","VAFCQRY1",76,0) ..S CT=0 F S CT=$O(VAFCA1(CT)) Q:+CT<1 D "RTN","VAFCQRY1",77,0) ...S NXT=$S($G(VAFCA1(CT,"SSN"))="":HL("Q"),1:$G(VAFCA1(CT,"SSN")))_COMP_COMP_COMP_"USSSA"_SUBCOMP_SUBCOMP_"0363"_COMP_"SS"_COMP_"VA FACILITY ID"_SUBCOMP_STN_SUBCOMP_"L"_COMP_COMP_$$HLDATE^HLFNC(DT,"DT") "RTN","VAFCQRY1",78,0) ...I LVL=0 D "RTN","VAFCQRY1",79,0) ....I $L(APID(4)_NXT)'>244 S APID(4)=APID(4)_REP_NXT Q "RTN","VAFCQRY1",80,0) ....I $L(APID(4)_NXT)>244 S LVL=1 S LNGTH=244-$L(APID(4)),APID(4)=APID(4)_REP_$E(NXT,1,LNGTH) S LNGTH=LNGTH+1,NXT=$E(NXT,LNGTH,$L(NXT)),NXTC=1 "RTN","VAFCQRY1",81,0) ...I LVL>0 D "RTN","VAFCQRY1",82,0) ....I $L($G(APID(4,LVL))_NXT)'>245 S APID(4,LVL)=$G(APID(4,LVL))_$S(NXTC=0:REP,1:"")_NXT Q "RTN","VAFCQRY1",83,0) ....I $L($G(APID(4,LVL))_NXT)>245 S LNGTH=244-$L(APID(4,LVL)),APID(4,LVL)=APID(4,LVL)_REP_$E(NXT,1,LNGTH) S LNGTH=LNGTH+1,NXT=$E(NXT,LNGTH,$L(NXT)) S LVL=LVL+1 S APID(4,LVL)=NXT "RTN","VAFCQRY1",84,0) ...I NXTC=1 S NXTC=0 "RTN","VAFCQRY1",85,0) .I $D(^DPT(DFN,"MPIFHIS")) N HIST S HIST=0 F S HIST=$O(^DPT(DFN,"MPIFHIS",HIST)) Q:'HIST S VAFCHMN=^DPT(DFN,"MPIFHIS",HIST,0) S HISTDT=$P(VAFCHMN,"^",4) D "RTN","VAFCQRY1",86,0) ..;**477 due to a timing issue if checksum and D/T of deprecation of ICN is not present hang two seconds and try again if still not able to get ICN set D/T to DT "RTN","VAFCQRY1",87,0) ..I $G(HISTDT)="" H 2 S VAFCHMN=^DPT(DFN,"MPIFHIS",HIST,0) S HISTDT=$P(VAFCHMN,"^",4) I HISTDT="" S HISTDT=DT "RTN","VAFCQRY1",88,0) ..I APID(4)'="" D "RTN","VAFCQRY1",89,0) ...; custom change - if current site is HAC then use station number 741MM - CH*1.3*22529 "RTN","VAFCQRY1",90,0) ...I $E($P(VAFCHMN,"^"),1,3)=+STN S SITA=+STN I SITA=741 S SITA="741MM" "RTN","VAFCQRY1",91,0) ...I $E($P(VAFCHMN,"^"),1,3)'=+STN S SITA="200M" ; **707 update assigning authority for national ICNs to 200M for MPI "RTN","VAFCQRY1",92,0) ...S NXT=$P(VAFCHMN,"^")_"V"_$P(VAFCHMN,"^",2)_COMP_COMP_COMP_"USVHA"_SUBCOMP_SUBCOMP_"0363"_COMP_"NI"_COMP_"VA FACILITY ID"_SUBCOMP_SITA_SUBCOMP_"L"_COMP_COMP_$$HLDATE^HLFNC(HISTDT,"DT") ;**648 only send date not time "RTN","VAFCQRY1",93,0) ...I LVL=0 D "RTN","VAFCQRY1",94,0) ....I $L(APID(4)_NXT)'>244 S APID(4)=APID(4)_REP_NXT Q "RTN","VAFCQRY1",95,0) ....I $L(APID(4)_NXT)>244 S LVL=1 S LNGTH=244-$L(APID(4)),APID(4)=APID(4)_REP_$E(NXT,1,LNGTH) S LNGTH=LNGTH+1,NXT=$E(NXT,LNGTH,$L(NXT)),NXTC=1 "RTN","VAFCQRY1",96,0) ...I LVL>0 D "RTN","VAFCQRY1",97,0) ....I $L($G(APID(4,LVL))_NXT)'>245 S APID(4,LVL)=$G(APID(4,LVL))_$S(NXTC=0:REP,1:"")_NXT Q "RTN","VAFCQRY1",98,0) ....I $L($G(APID(4,LVL))_NXT)>245 S LNGTH=244-$L(APID(4,LVL)),APID(4,LVL)=APID(4,LVL)_REP_$E(NXT,1,LNGTH) S LNGTH=LNGTH+1,NXT=$E(NXT,LNGTH,$L(NXT)) S LVL=LVL+1 S APID(4,LVL)=NXT "RTN","VAFCQRY1",99,0) ..I NXTC=1 S NXTC=0 "RTN","VAFCQRY1",100,0) ..I APID(4)="" D "RTN","VAFCQRY1",101,0) ...; custom change - if current site is HAC then use station number 741MM - CH*1.3*22529 "RTN","VAFCQRY1",102,0) ...I $E($P(VAFCHMN,"^"),1,3)=+STN S SITA=+STN I SITA=741 S SITA="741MM" "RTN","VAFCQRY1",103,0) ...I $E($P(VAFCHMN,"^"),1,3)'=+STN S SITA="200M" "RTN","VAFCQRY1",104,0) ...S APID(4)=$P(VAFCHMN,"^")_COMP_COMP_COMP_"USVHA"_SUBCOMP_SUBCOMP_"0363"_COMP_"NI"_COMP_"VA FACILITY ID"_SUBCOMP_SITA_SUBCOMP_"L"_COMP_COMP_$$HLDATE^HLFNC(HISTDT,"DT") ;**707 ONLY DATE NOT TIME "RTN","VAFCQRY1",105,0) ; "RTN","VAFCQRY1",106,0) ALTID ;**874 MVI_3035 (elz) alternate ID "RTN","VAFCQRY1",107,0) I $D(SARY(4))!(SEQ="ALL") D "RTN","VAFCQRY1",108,0) . S REF=$NA(APID(5)),@REF="",LVL=0 "RTN","VAFCQRY1",109,0) . I $G(DFN) D "RTN","VAFCQRY1",110,0) .. ;VIC card number, station 742V1 "RTN","VAFCQRY1",111,0) .. N VAVICF,VAVICX,VAVIC,X "RTN","VAFCQRY1",112,0) .. S VAVICF=+$$LKUP^XUAF4("742V1") "RTN","VAFCQRY1",113,0) .. S VAVICX=0 F S VAVICX=$O(^DGCN(391.91,"APAT",DFN,VAVICF,VAVICX)) Q:'VAVICX D "RTN","VAFCQRY1",114,0) ... F X=0,2 S VAVIC(X)=$G(^DGCN(391.91,VAVICX,X)) "RTN","VAFCQRY1",115,0) ... I $P(VAVIC(2),"^",2),$P(VAVIC(2),"^",3)'="H",$L($P(VAVIC(2),"^")),$L($P(VAVIC(0),"^",9)) D "RTN","VAFCQRY1",116,0) .... D ADDLINE($P(VAVIC(2),"^",2)_COMP_COMP_COMP_$P(VAVIC(2),"^")_SUBCOMP_SUBCOMP_"0363"_COMP_$P(VAVIC(0),"^",9)_COMP_"VA FACILITY ID"_SUBCOMP_"742V1"_SUBCOMP_"L",.LVL,REF,REP) "RTN","VAFCQRY1",117,0) ; "RTN","VAFCQRY1",118,0) NAMEPID ;patient name (last^first^middle^suffix^prefix^^"L" for legal) "RTN","VAFCQRY1",119,0) I $D(SARY(5))!(SEQ="ALL") D "RTN","VAFCQRY1",120,0) .;**711 code REMOVED PREFIX due to issues with existing PATIENT Name Standardization functionality "RTN","VAFCQRY1",121,0) .N X S X=$P(VAFCZN,"^") D NAME^VAFCPID2(DFN,.X) S APID(6)=$$HLNAME^XLFNAME(X,"",$E(HL("ECH"),1)) I $P(APID(6),$E(HL("ECH"),1),7)'="L" S $P(APID(6),$E(HL("ECH"),1),7)="L" "RTN","VAFCQRY1",122,0) PREFNAME .; Story 455447 (elz)DG*5.3*937 Preferred Name (^preferred name^^^^^"N" for nickname) "RTN","VAFCQRY1",123,0) .N PREFNAM S PREFNAM=$P($G(^DPT(DFN,.24)),"^",5) "RTN","VAFCQRY1",124,0) .D HL7TXT(.PREFNAM,.HL,HLES) S APID(6)=APID(6)_$S(APID(6)]"":REP,1:"")_$S(PREFNAM]"":PREFNAM,1:"""""")_COMP_COMP_COMP_COMP_COMP_COMP_"N" "RTN","VAFCQRY1",125,0) ALIAS .;patient alias (last^first^middle^suffice^prefix^^"A" for alias - can be multiple) "RTN","VAFCQRY1",126,0) .N ALIAS,ALIEN,LVL6,NXTC,LNGTH S NXTC=0,LVL6=0 "RTN","VAFCQRY1",127,0) .I $D(VAFCA1) S ALIEN=0 F S ALIEN=$O(VAFCA1(ALIEN)) Q:'ALIEN D "RTN","VAFCQRY1",128,0) ..;**974,Story 841921 (mko): Get the Name Components themselves "RTN","VAFCQRY1",129,0) ..; rather than parsing them out of the Name field "RTN","VAFCQRY1",130,0) ..I $G(VAFCA1(ALIEN,"NCIEN"))>0 D "RTN","VAFCQRY1",131,0) ...N NAMEC "RTN","VAFCQRY1",132,0) ...S NAMEC("FILE")=2.01,NAMEC("IENS")=$P(VAFCA1(ALIEN,"NCIEN"),"^",2),NAMEC("FIELD")=.01 "RTN","VAFCQRY1",133,0) ...S ALIAS=$$HLNAME^XLFNAME(.NAMEC,"",$E(HL("ECH"))) "RTN","VAFCQRY1",134,0) ..E S ALIAS=$$HLNAME^XLFNAME(VAFCA1(ALIEN,"NAME"),"",$E(HL("ECH"),1)) "RTN","VAFCQRY1",135,0) ..Q:ALIAS="" "RTN","VAFCQRY1",136,0) ..S $P(ALIAS,$E(HL("ECH"),1),7)="A" "RTN","VAFCQRY1",137,0) ..I LVL6=0 D "RTN","VAFCQRY1",138,0) ...I $L(APID(6)_ALIAS)'>244 S APID(6)=APID(6)_REP_ALIAS Q "RTN","VAFCQRY1",139,0) ...I $L(APID(6)_ALIAS)>244 S LVL6=1 S LNGTH=244-$L(APID(6)),APID(6)=APID(6)_REP_$E(ALIAS,1,LNGTH) S LNGTH=LNGTH+1,ALIAS=$E(ALIAS,LNGTH,$L(ALIAS)),NXTC=1 "RTN","VAFCQRY1",140,0) ..I LVL6>0 D "RTN","VAFCQRY1",141,0) ...I $L($G(APID(6,LVL6))_ALIAS)'>245 S APID(6,LVL6)=$G(APID(6,LVL6))_$S(NXTC=0:REP,1:"")_ALIAS Q "RTN","VAFCQRY1",142,0) ...I $L($G(APID(6,LVL6))_ALIAS)>245 S LNGTH=244-$L(APID(6,LVL6)),APID(6,LVL6)=APID(6,LVL6)_REP_$E(ALIAS,1,LNGTH) S LNGTH=LNGTH+1,ALIAS=$E(ALIAS,LNGTH,$L(ALIAS)) S LVL6=LVL6+1 S APID(6,LVL6)=ALIAS "RTN","VAFCQRY1",143,0) ..I NXTC=1 S NXTC=0 "RTN","VAFCQRY1",144,0) . I APID(6)="" S APID(6)=HL("Q") "RTN","VAFCQRY1",145,0) MOTHER ;mother's maiden name (last^first^middle^suffix^prefix^^"M" for maiden name) "RTN","VAFCQRY1",146,0) I $D(SARY(6))!(SEQ="ALL") D "RTN","VAFCQRY1",147,0) .S APID(7)=HL("Q") "RTN","VAFCQRY1",148,0) .I $D(^DPT(DFN,.24)) S VAFCMMN=$P(^DPT(DFN,.24),"^",3) D "RTN","VAFCQRY1",149,0) ..S APID(7)=$$HLNAME^XLFNAME(VAFCMMN,"",$E(HL("ECH"),1)) I APID(7)="" S APID(7)=HL("Q") "RTN","VAFCQRY1",150,0) ..I $P(APID(7),$E(HL("ECH"),1),7)'="M" S $P(APID(7),$E(HL("ECH"),1),7)="M" "RTN","VAFCQRY1",151,0) .I APID(7)="" S APID(7)=HL("Q") "RTN","VAFCQRY1",152,0) I $D(SARY(7))!(SEQ="ALL") S APID(8)=$$HLDATE^HLFNC($P(VAFCZN,"^",3)) I APID(8)="" S APID(8)=HL("Q") ;date/time of birth "RTN","VAFCQRY1",153,0) I $D(SARY(8))!(SEQ="ALL") S APID(9)=$P(VAFCZN,"^",2) I APID(9)="" S APID(9)=HL("Q") ;sex "RTN","VAFCQRY1",154,0) ;place of birth city and state "RTN","VAFCQRY1",155,0) ;split into 2 routines **707 "RTN","VAFCQRY1",156,0) D CONT^VAFCQRY3(DFN,.APID,.PID,.HL,HLES,.SARY,SEQ,.ERR,REP,COMP,SSN,VAFCMN) "RTN","VAFCQRY1",157,0) D KVA^VADPT "RTN","VAFCQRY1",158,0) Q "RTN","VAFCQRY1",159,0) ; "RTN","VAFCQRY1",160,0) HL7TXT(HL7STRG,HL,HLES) ; Replace occurrences of embedded HL7 delimiters with "RTN","VAFCQRY1",161,0) ; HL7 escape sequence "RTN","VAFCQRY1",162,0) ; "RTN","VAFCQRY1",163,0) ; Inputs: HL7STRG - Data string to be checked "RTN","VAFCQRY1",164,0) ; HL("ECH") - HL7 delimiter string "RTN","VAFCQRY1",165,0) ; Delimiters MUST be in the following order, "RTN","VAFCQRY1",166,0) ; Escape, Field, Component, Repeat, Subcomponent "RTN","VAFCQRY1",167,0) ; Example: \^~|& "RTN","VAFCQRY1",168,0) ; "RTN","VAFCQRY1",169,0) ; Output: HL7XTRG - Data string with escape sequence added (if needed) "RTN","VAFCQRY1",170,0) ; "RTN","VAFCQRY1",171,0) N OCHR,RCHR,RCHRI,TYPE,I,HLES2 "RTN","VAFCQRY1",172,0) ; "RTN","VAFCQRY1",173,0) I $G(HL("COMP"))="" S HL("COMP")=$E(HL("ECH"),1),HL("REP")=$E(HL("ECH"),2),HL("SUBCOMP")=$E(HL("ECH"),4) "RTN","VAFCQRY1",174,0) ; Set HL7 escape char "RTN","VAFCQRY1",175,0) S HLES2=HLES_HL("FS")_HL("COMP")_HL("REP")_HL("SUBCOMP") "RTN","VAFCQRY1",176,0) ; "RTN","VAFCQRY1",177,0) ; Search for occurrence of each delimiter and replace it with "\\" "RTN","VAFCQRY1",178,0) F TYPE="E","F","C","R","S" D "RTN","VAFCQRY1",179,0) . S RCHRI=$S(TYPE="E":1,TYPE="F":2,TYPE="C":3,TYPE="R":4,TYPE="S":5) "RTN","VAFCQRY1",180,0) . ; "RTN","VAFCQRY1",181,0) . ; OCHR=original char, RCHR=replacement char "RTN","VAFCQRY1",182,0) . S OCHR=$E(HLES2,RCHRI),RCHR=$E("EFSRT",RCHRI) Q:'$F(HL7STRG,OCHR) "RTN","VAFCQRY1",183,0) . F I=1:1 Q:$E(HL7STRG,I)="" I $E(HL7STRG,I)=OCHR S HL7STRG=$E(HL7STRG,1,I-1)_HLES_RCHR_HLES_$E(HL7STRG,I+1,999),I=I+2 "RTN","VAFCQRY1",184,0) Q "RTN","VAFCQRY1",185,0) ; "RTN","VAFCQRY1",186,0) ADDLINE(NXT,LVL,REF,REP) ; Prepend REP to NXT and add it to the @REF "RTN","VAFCQRY1",187,0) ; array, starting at subscript LVL. If appending NXT causes the node "RTN","VAFCQRY1",188,0) ; to exceed 245 chars in length, add as much of NXT as possible to the "RTN","VAFCQRY1",189,0) ; current level, and the remaining at the next level. "RTN","VAFCQRY1",190,0) ; In: "RTN","VAFCQRY1",191,0) ; NXT = string to add to the @REF array "RTN","VAFCQRY1",192,0) ; .LVL = current subscript level (passed by referenced) "RTN","VAFCQRY1",193,0) ; REF = array reference string "RTN","VAFCQRY1",194,0) ; REP = repetition character (e.g., |) "RTN","VAFCQRY1",195,0) ; **837,MVI_879: Created this subroutine to aid in adding TIN and FIN to PID-3. "RTN","VAFCQRY1",196,0) N LNGTH,CURREF "RTN","VAFCQRY1",197,0) S:$G(LVL)<1 LVL=0 "RTN","VAFCQRY1",198,0) S CURREF=$S(LVL=0:REF,1:$NA(@REF@(LVL))) "RTN","VAFCQRY1",199,0) I LVL>0!($G(@CURREF)]"") S NXT=REP_NXT "RTN","VAFCQRY1",200,0) I $L($G(@CURREF))+$L(NXT)'>245 S @CURREF=$G(@CURREF)_NXT "RTN","VAFCQRY1",201,0) E S LNGTH=245-$L(@CURREF),@CURREF=@CURREF_$E(NXT,1,LNGTH),LVL=LVL+1,@REF@(LVL)=$E(NXT,LNGTH+1,$L(NXT)) "RTN","VAFCQRY1",202,0) Q "RTN","VAFCQRY1",203,0) ; "RTN","VAFCSB") 0^6^B75363862^B50707887 "RTN","VAFCSB",1,0) VAFCSB ;BIR/CMC-CONT ADT PROCESSOR TO RETRIGGER A08 or A04 MESSAGES WITH AL/AL (COMMIT/APPLICATION) ACKNOWLEDGEMENTS ;7/14/21 15:25 "RTN","VAFCSB",2,0) ;;5.3;Registration;**707,756,825,876,902,926,967,1059**;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) ;Reference to PROF^PSO52API is supported by IA #4820 "RTN","VAFCSB",7,0) ; "RTN","VAFCSB",8,0) PV2() ;build pv2 segment "RTN","VAFCSB",9,0) N PV2,LSTA,APPT,VASD,VAIP,VARP,VAROOT "RTN","VAFCSB",10,0) S PV2="" "RTN","VAFCSB",11,0) ;get next outpatient appointment "RTN","VAFCSB",12,0) K ^UTILITY("VASD",$J) S VASD("F")=DT D SDA^VADPT "RTN","VAFCSB",13,0) S APPT=$P($G(^UTILITY("VASD",$J,1,"I")),"^") "RTN","VAFCSB",14,0) I APPT'="" S $P(PV2,HL("FS"),9)=$$HLDATE^HLFNC(APPT) "RTN","VAFCSB",15,0) ;GET LAST ADMISSION DATE "RTN","VAFCSB",16,0) K VAIP S VAIP("D")="LAST",VAIP("M")=0 D IN5^VADPT "RTN","VAFCSB",17,0) ; **825,CR_1184: for PV2-14, it will be re-set as the 15th piece "RTN","VAFCSB",18,0) ; in PV2 segment a few lines below "RTN","VAFCSB",19,0) ; I VAIP(2)="1^ADMISSION" S $P(PV2,HL("FS"),15)=$$HLDATE^HLFNC($P(VAIP(3),"^")) "RTN","VAFCSB",20,0) I VAIP(2)="1^ADMISSION" S $P(PV2,HL("FS"),14)=$$HLDATE^HLFNC($P(VAIP(3),"^")) "RTN","VAFCSB",21,0) ;get last registration "RTN","VAFCSB",22,0) S VAROOT="VARP" "RTN","VAFCSB",23,0) D REG^VADPT "RTN","VAFCSB",24,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",25,0) ;**756 ^ ONLY RETURN DATE FOR LAST REGISTRATION AS HL7 STANDARD CAN ONLY HAVE DATE "RTN","VAFCSB",26,0) I PV2'="" S PV2="PV2"_HL("FS")_PV2 "RTN","VAFCSB",27,0) Q PV2 "RTN","VAFCSB",28,0) ; "RTN","VAFCSB",29,0) PHARA() ;build obx to show active prescriptions "RTN","VAFCSB",30,0) N RET S RET="" "RTN","VAFCSB",31,0) I '$$PATCH^XPDUTL("PSS*1.0*101") Q RET "RTN","VAFCSB",32,0) N PHARM,DGLIST "RTN","VAFCSB",33,0) S PHARM="" D PROF^PSO52API(DFN,"DGLIST") "RTN","VAFCSB",34,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",35,0) ;**756 CE added as the data type "RTN","VAFCSB",36,0) Q PHARM "RTN","VAFCSB",37,0) ; "RTN","VAFCSB",38,0) SIG(DFN) ;**876 MVI_3467 (ckn) Build OBX for Self Identified Gender "RTN","VAFCSB",39,0) N SIG,SIGE,SIGTMP,OBX S OBX="" "RTN","VAFCSB",40,0) ;I '$$PATCH^XPDUTL("DG*5.3*876") Q OBX "RTN","VAFCSB",41,0) S DIC=2,DA=DFN,DR=".024",DIQ="SIGTMP",DIQ(0)="I,E,N" D EN^DIQ1 "RTN","VAFCSB",42,0) I '$D(SIGTMP) K DA,DR,DIQ Q OBX "RTN","VAFCSB",43,0) S SIG=$G(SIGTMP(2,DFN,DR,"I")),SIGE=$G(SIGTMP(2,DFN,DR,"E")) "RTN","VAFCSB",44,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",45,0) K DA,DR,DIC,DIQ "RTN","VAFCSB",46,0) Q OBX "RTN","VAFCSB",47,0) ; "RTN","VAFCSB",48,0) DODF(DFN) ;**902 MVI_4898 (ckn) Build OBX for DOD fields "RTN","VAFCSB",49,0) N DODTMP,DODEB,DODLEB,DODSRC,DODLUPD,DODSRCI,DODSRCE,CS,DODLNAM "RTN","VAFCSB",50,0) N DODFNAM,DODMNAM,DODEBE,DODEBI,DODLEBE,DODLEBI,DODSRCCD "RTN","VAFCSB",51,0) S CS=$E(HL("ECH")),SC=$E(HL("ECH"),4) "RTN","VAFCSB",52,0) S DIC=2,DA=DFN,DR=".352;.353;.354;.355",DIQ="DODTMP",DIQ(0)="I,E,N" D EN^DIQ1 "RTN","VAFCSB",53,0) S DODSRCI=$G(DODTMP(2,DFN,.353,"I")),DODSRCE=$G(DODTMP(2,DFN,.353,"E")),DODSRC=HL("Q") "RTN","VAFCSB",54,0) ; **926, Story #323009 (ckn): Source of Notification moved from set of codes to pointer which is pointing to new Source Of Notification file (#47.76) "RTN","VAFCSB",55,0) I DODSRCE'="" D "RTN","VAFCSB",56,0) . S DODSRCCD=$P($G(^DG(47.76,DODSRCI,0)),"^",2) "RTN","VAFCSB",57,0) . S DODSRC=DODSRCCD_CS_DODSRCE_CS_"L" "RTN","VAFCSB",58,0) I DODSRCE'="" S DODSRC=DODSRCI_CS_DODSRCE_CS_"L" "RTN","VAFCSB",59,0) S DODLUPD=$G(DODTMP(2,DFN,.354,"I")) S DODLUPD=$S(DODLUPD="":HL("Q"),1:$$HLDATE^HLFNC(DODLUPD)) "RTN","VAFCSB",60,0) ;If LAST EDITED BY field(#.355) have value, use it to populate sequence 16 of OBX "RTN","VAFCSB",61,0) ;If LAST EDITED BY field(#.355) does not have value, use DEATH ENTERED BY field(#.352) to populate sequence 16 of OBX "RTN","VAFCSB",62,0) ;If both fields empty, send double quotes in sequence 16 of OBX "RTN","VAFCSB",63,0) S DODLEB=HL("Q") ;Default seq 16 "RTN","VAFCSB",64,0) S DODEBE=$G(DODTMP(2,DFN,.352,"E")),DODEBI=$G(DODTMP(2,DFN,.352,"I")) ;DOD Entered by "RTN","VAFCSB",65,0) S DODLEBE=$G(DODTMP(2,DFN,.355,"E")),DODLEBI=$G(DODTMP(2,DFN,.355,"I")) ;DOD Last Edited By "RTN","VAFCSB",66,0) I DODLEBE'="" D "RTN","VAFCSB",67,0) .S DODLEBE=$$HLNAME^HLFNC(DODLEBE,CS),DODLNAM=$S($P(DODLEBE,CS)="":HL("Q"),1:$P(DODLEBE,CS)),DODFNAM=$S($P(DODLEBE,CS,2)="":HL("Q"),1:$P(DODLEBE,CS,2)),DODMNAM=$S($P(DODLEBE,CS,3)="":HL("Q"),1:$P(DODLEBE,CS,3)) "RTN","VAFCSB",68,0) .S DODLEB=$S(DODLEBI="":HL("Q"),1:DODLEBI)_CS_DODLNAM_CS_DODFNAM_CS_DODMNAM_CS_CS_CS_CS_CS_"USVHA"_SC_SC_"0363"_CS_"L"_CS_CS_CS_"PN"_CS_"VA FACILITY ID"_SC_$P($$SITE^VASITE(),"^",3)_SC_"L" "RTN","VAFCSB",69,0) I DODLEBE="",(DODEBE'="") D "RTN","VAFCSB",70,0) .S DODEBE=$$HLNAME^HLFNC(DODEBE,CS),DODLNAM=$S($P(DODEBE,CS)="":HL("Q"),1:$P(DODEBE,CS)),DODFNAM=$S($P(DODEBE,CS,2)="":HL("Q"),1:$P(DODEBE,CS,2)),DODMNAM=$S($P(DODEBE,CS,3)="":HL("Q"),1:$P(DODEBE,CS,3)) "RTN","VAFCSB",71,0) .S DODLEB=$S(DODEBI="":HL("Q"),1:DODEBI)_CS_DODLNAM_CS_DODFNAM_CS_DODMNAM_CS_CS_CS_CS_CS_"USVHA"_SC_SC_"0363"_CS_"L"_CS_CS_CS_"PN"_CS_"VA FACILITY ID"_SC_$P($$SITE^VASITE(),"^",3)_SC_"L" "RTN","VAFCSB",72,0) S OBX="OBX"_HL("FS")_HL("FS")_"CE"_HL("FS")_"DATE OF DEATH DATA"_HL("FS")_HL("FS")_DODSRC_HL("FS")_HL("FS")_HL("FS")_HL("FS")_HL("FS")_HL("FS")_"R"_HL("FS")_HL("FS")_HL("FS")_DODLUPD_HL("FS")_HL("FS")_$G(DODLEB) "RTN","VAFCSB",73,0) K DA,DR,DIC,DIQ "RTN","VAFCSB",74,0) Q OBX "RTN","VAFCSB",75,0) ; "RTN","VAFCSB",76,0) DODD(DFN) ;**926, Story #323009 (ckn): Build OBX for DATE OF DEATH DOCUMENTS "RTN","VAFCSB",77,0) N OBX,DODTMP,DODDI,DODD,DODDE,DODDCD "RTN","VAFCSB",78,0) S CS=$E(HL("ECH")) "RTN","VAFCSB",79,0) S DIC=2,DA=DFN,DR=".357",DIQ="DODTMP",DIQ(0)="I,E,N" D EN^DIQ1 "RTN","VAFCSB",80,0) S DODDI=$G(DODTMP(2,DFN,.357,"I")),DODDE=$G(DODTMP(2,DFN,.357,"E")),DODD=HL("Q") "RTN","VAFCSB",81,0) I DODDE'="" D "RTN","VAFCSB",82,0) . S DODDCD=$P($G(^DG(47.75,DODDI,0)),"^",2) "RTN","VAFCSB",83,0) . S DODD=DODDCD_CS_DODDE_CS_"L" "RTN","VAFCSB",84,0) S OBX="OBX"_HL("FS")_HL("FS")_"CE"_HL("FS")_"DATE OF DEATH DOCUMENTS"_HL("FS")_HL("FS")_DODD "RTN","VAFCSB",85,0) K DA,DR,DIC,DIQ "RTN","VAFCSB",86,0) Q OBX "RTN","VAFCSB",87,0) ; "RTN","VAFCSB",88,0) DODOPT(DFN) ;**926, Story #323009 (ckn): Build OBX for DATE OF DEATH OPTION "RTN","VAFCSB",89,0) N OBX,DODOPT,DODOPTE,DODOPTI "RTN","VAFCSB",90,0) S CS=$E(HL("ECH")) "RTN","VAFCSB",91,0) S DIC=2,DA=DFN,DR=".358",DIQ="DODTMP",DIQ(0)="I,E,N" D EN^DIQ1 "RTN","VAFCSB",92,0) S DODOPTE=$G(DODTMP(2,DFN,.358,"E")),DODOPTI=$G(DODTMP(2,DFN,.358,"I")),DODOPT=HL("Q") "RTN","VAFCSB",93,0) I DODOPTE'="" S DODOPT=DODOPTI_CS_DODOPTE_CS_"L" "RTN","VAFCSB",94,0) S OBX="OBX"_HL("FS")_HL("FS")_"CE"_HL("FS")_"DATE OF DEATH OPTION"_HL("FS")_HL("FS")_DODOPT "RTN","VAFCSB",95,0) K DA,DR,DIC,DIQ "RTN","VAFCSB",96,0) Q OBX "RTN","VAFCSB",97,0) ; "RTN","VAFCSB",98,0) DODDISDT(DFN) ;**926, Story #323009 (ckn): Build OBX for DATE OF DEATH DISCHARGE DATE "RTN","VAFCSB",99,0) ;Q OBX "RTN","VAFCSB",100,0) ; "RTN","VAFCSB",101,0) DODNTPRV(DFN) ;**926, Story #323009 (ckn): Build OBX for DATE OF DEATH NOTIFICATION "RTN","VAFCSB",102,0) N OBX,DODNP,STN "RTN","VAFCSB",103,0) S CS=$E(HL("ECH")),STN=$$SITE^VASITE(),DODNP="" "RTN","VAFCSB",104,0) ;Populate notify provider if Date of Death last updated have value "RTN","VAFCSB",105,0) I $$GET1^DIQ(2,DFN_",",.354,"I")'="" S DODNP=$P(STN,"^",3)_CS_$P(STN,"^",2)_CS_"L" "RTN","VAFCSB",106,0) S OBX="OBX"_HL("FS")_HL("FS")_"CE"_HL("FS")_"NOTIFY PROVIDER"_HL("FS")_HL("FS")_DODNP "RTN","VAFCSB",107,0) Q OBX "RTN","VAFCSB",108,0) ; "RTN","VAFCSB",109,0) SECLOG(DFN) ;**1059, Story #783361 (ckn): Build OBX for Sensitivity information "RTN","VAFCSB",110,0) N OBX,SECLVL,SECLOG "RTN","VAFCSB",111,0) S CS=$E(HL("ECH")),OBX="" "RTN","VAFCSB",112,0) S DA=$O(^DGSL(38.1,"B",DFN,"")) I DA="" Q OBX "RTN","VAFCSB",113,0) S DIC=38.1,DR="2",DIQ="SECLOG",DIQ(0)="I,E,N" D EN^DIQ1 "RTN","VAFCSB",114,0) S SECLVL=$G(SECLOG(38.1,DA,2,"I")) I SECLVL="" Q OBX "RTN","VAFCSB",115,0) S SECLVL=SECLVL_CS_$G(SECLOG(38.1,DA,2,"E"))_CS_"L" "RTN","VAFCSB",116,0) S OBX="OBX"_HL("FS")_HL("FS")_"CE"_HL("FS")_"SECURITY LEVEL"_HL("FS")_HL("FS")_SECLVL_HL("FS")_HL("FS")_HL("FS")_HL("FS")_HL("FS")_HL("FS")_"F" "RTN","VAFCSB",117,0) Q OBX "RTN","VAFCSB",118,0) ; "RTN","VAFCSB",119,0) NAMEOBX(DFN) ;**876,MVI_3453 (mko): Build OBX for Patient .01 and Name Components "RTN","VAFCSB",120,0) N FS "RTN","VAFCSB",121,0) S FS=HL("FS") "RTN","VAFCSB",122,0) Q "OBX"_FS_FS_"CE"_FS_"NAME COMPONENTS"_FS_FS_$$NAMECOMP(DFN,$E(HL("ECH"))) "RTN","VAFCSB",123,0) ; "RTN","VAFCSB",124,0) NAMEERR(DFN) ;**876,MVI_3453 (mko): Build ERR for Patient .01 and Name Components "RTN","VAFCSB",125,0) N CS,SC "RTN","VAFCSB",126,0) S CS=$E(HL("ECH")),SC=$E(HL("ECH"),4) "RTN","VAFCSB",127,0) Q "ERR"_HL("FS")_CS_CS_CS_SC_$$NAMECOMP(DFN,SC) "RTN","VAFCSB",128,0) ; "RTN","VAFCSB",129,0) NAMECOMP(DFN,DELIM) ;**876,MVI_3453 (mko): Return Patient .01 and Name Components "RTN","VAFCSB",130,0) N DIHELP,DIMSG,DIERR,MSG,NC,NCIEN,NCIENS,NCPTR,TARG "RTN","VAFCSB",131,0) S NC=$P($G(^DPT(DFN,0)),"^") "RTN","VAFCSB",132,0) S NCPTR=$P($G(^DPT(DFN,"NAME")),"^") Q:'NCPTR NC "RTN","VAFCSB",133,0) S NCIEN=$$FIND1^DIC(20,"","","`"_NCPTR,"","","MSG") Q:'NCIEN NC "RTN","VAFCSB",134,0) S NCIENS=NCIEN_"," "RTN","VAFCSB",135,0) D GETS^DIQ(20,NCIENS,"1:5","","TARG","MSG") Q:$G(DIERR) NC "RTN","VAFCSB",136,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",137,0) Q NC "RTN","VAFCSB",138,0) ; "RTN","VAFCSB",139,0) SEXOR(DFN,OBX) ;build obx for sexual orientation multiple ;**1059, VAMPI-11114 (dri) "RTN","VAFCSB",140,0) N IENS,OBXCNT,SEXOR,SEXORCODE,SEXORIEN,SEXORTYP "RTN","VAFCSB",141,0) D GETS^DIQ(2,DFN_",",".025*","IE","SEXOR") "RTN","VAFCSB",142,0) I '$D(SEXOR) Q "RTN","VAFCSB",143,0) S OBXCNT=1,IENS="" F S IENS=$O(SEXOR(2.025,IENS)) Q:IENS="" S SEXORIEN=+$G(SEXOR(2.025,IENS,.01,"I")) I SEXORIEN D "RTN","VAFCSB",144,0) .S SEXORCODE=$$GET1^DIQ(47.77,SEXORIEN_",",1) "RTN","VAFCSB",145,0) .S SEXORTYP=$G(SEXOR(2.025,IENS,.01,"E")) "RTN","VAFCSB",146,0) .S OBX(OBXCNT)="OBX"_HL("FS")_HL("FS")_"CE"_HL("FS")_"Sexual Orientation"_HL("FS")_HL("FS")_SEXORCODE_$E(HL("ECH"),1)_SEXORTYP_$E(HL("ECH"),1)_"L" S OBXCNT=OBXCNT+1 "RTN","VAFCSB",147,0) Q "RTN","VAFCSB",148,0) ; "RTN","VAFCSB",149,0) SEXORD(DFN,OBX) ;build obx for sexual orientation description ;**1059, VAMPI-11114 (dri) "RTN","VAFCSB",150,0) N SEXORDES "RTN","VAFCSB",151,0) S SEXORDES=$$GET1^DIQ(2,DFN_",",.0251) "RTN","VAFCSB",152,0) I SEXORDES="" Q "RTN","VAFCSB",153,0) S OBX(1)="OBX"_HL("FS")_HL("FS")_"ST"_HL("FS")_"Sexual Or Description"_HL("FS")_HL("FS")_$E(HL("ECH"),1)_SEXORDES_$E(HL("ECH"),1)_"L" "RTN","VAFCSB",154,0) I $L(OBX(1))>245 D "RTN","VAFCSB",155,0) .S OBX(2)=$E(OBX(1),246,$L(OBX(1))) "RTN","VAFCSB",156,0) .S OBX(1)=$E(OBX(1),1,245) "RTN","VAFCSB",157,0) Q "RTN","VAFCSB",158,0) ; "RTN","VAFCSB",159,0) PRON(DFN,OBX) ;build obx for pronoun multiple ;**1059, VAMPI-11118 (dri) "RTN","VAFCSB",160,0) N IENS,OBXCNT,PRON,PRONCODE,PRONIEN,PRONTYP "RTN","VAFCSB",161,0) D GETS^DIQ(2,DFN_",",".2406*","IE","PRON") "RTN","VAFCSB",162,0) I '$D(PRON) Q "RTN","VAFCSB",163,0) S OBXCNT=1,IENS="" F S IENS=$O(PRON(2.2406,IENS)) Q:IENS="" S PRONIEN=+$G(PRON(2.2406,IENS,.01,"I")) I PRONIEN D "RTN","VAFCSB",164,0) .S PRONCODE=$$GET1^DIQ(47.78,PRONIEN_",",1) "RTN","VAFCSB",165,0) .S PRONTYP=$G(PRON(2.2406,IENS,.01,"E")) "RTN","VAFCSB",166,0) .S OBX(OBXCNT)="OBX"_HL("FS")_HL("FS")_"CE"_HL("FS")_"Pronoun"_HL("FS")_HL("FS")_PRONCODE_$E(HL("ECH"),1)_PRONTYP_$E(HL("ECH"),1)_"L" S OBXCNT=OBXCNT+1 "RTN","VAFCSB",167,0) Q "RTN","VAFCSB",168,0) ; "RTN","VAFCSB",169,0) PROND(DFN,OBX) ;build obx for pronoun description ;**1059, VAMPI-11118 (dri) "RTN","VAFCSB",170,0) N PRONDES "RTN","VAFCSB",171,0) S PRONDES=$$GET1^DIQ(2,DFN_",",.24061) "RTN","VAFCSB",172,0) I PRONDES="" Q "RTN","VAFCSB",173,0) S OBX(1)="OBX"_HL("FS")_HL("FS")_"ST"_HL("FS")_"Pronoun Description"_HL("FS")_HL("FS")_$E(HL("ECH"),1)_PRONDES_$E(HL("ECH"),1)_"L" "RTN","VAFCSB",174,0) I $L(OBX(1))>245 D "RTN","VAFCSB",175,0) .S OBX(2)=$E(OBX(1),246,$L(OBX(1))) "RTN","VAFCSB",176,0) .S OBX(1)=$E(OBX(1),1,245) "RTN","VAFCSB",177,0) Q "RTN","VAFCSB",178,0) ; "RTN","VAFCSB",179,0) LABE() ;BUILD OBX FOR LAST LAB TEST DATE "RTN","VAFCSB",180,0) N OBX S OBX="" "RTN","VAFCSB",181,0) I '$$PATCH^XPDUTL("LR*5.2*295") Q OBX "RTN","VAFCSB",182,0) N LAB,LAB2,EN "RTN","VAFCSB",183,0) S LAB="" K ^TMP("DGLAB",$J) D RESULTS^LRPXAPI("DGLAB",DFN,"C") "RTN","VAFCSB",184,0) S EN=$O(^TMP("DGLAB",$J,"")) I EN'="" S LAB=$P($G(^TMP("DGLAB",$J,EN)),"^") "RTN","VAFCSB",185,0) K ^TMP("DGLAB",$J) D RESULTS^LRPXAPI("DGLAB",DFN,"A") "RTN","VAFCSB",186,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",187,0) K ^TMP("DGLAB",$J) D RESULTS^LRPXAPI("DGLAB",DFN,"M") "RTN","VAFCSB",188,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",189,0) I LAB'="" D "RTN","VAFCSB",190,0) .S $P(OBX,HL("FS"),2)="TS" ;**756 added the data type "RTN","VAFCSB",191,0) .S $P(OBX,HL("FS"),3)="LAST LAB TEST DATE/TIME" "RTN","VAFCSB",192,0) .S $P(OBX,HL("FS"),11)="F" "RTN","VAFCSB",193,0) .S $P(OBX,HL("FS"),14)=$$HLDATE^HLFNC(LAB) "RTN","VAFCSB",194,0) .S OBX="OBX"_HL("FS")_OBX "RTN","VAFCSB",195,0) Q OBX "RTN","VAFCSB",196,0) ; "RTN","VAFCSB",197,0) RADE() ;BUILD OBX FOR LAST RADIOLOGY TEST DATE "RTN","VAFCSB",198,0) N RET S RET="" "RTN","VAFCSB",199,0) I '$$PATCH^XPDUTL("RA*5.0*76") Q RET "RTN","VAFCSB",200,0) N RAD,RADE "RTN","VAFCSB",201,0) S RAD="",RADE=$$XAMDT^RAO7UTL1(DFN) I +RADE<1 Q RAD "RTN","VAFCSB",202,0) I +RADE>0 D "RTN","VAFCSB",203,0) .S $P(OBX,HL("FS"),2)="TS" ;**756 added the data type "RTN","VAFCSB",204,0) .S $P(RAD,HL("FS"),3)="LAST RADIOLOGY EXAM DATE/TIME" "RTN","VAFCSB",205,0) .S $P(RAD,HL("FS"),11)="F" "RTN","VAFCSB",206,0) .S $P(RAD,HL("FS"),14)=$$HLDATE^HLFNC(RADE) "RTN","VAFCSB",207,0) .S RAD="OBX"_HL("FS")_RAD "RTN","VAFCSB",208,0) Q RAD "RTN","VAFCSB",209,0) ; "RTN","VAFCSB",210,0) PD1() ;BUILD PD1 segment "RTN","VAFCSB",211,0) ;PREFERRED FACILITY -- NOT GOING TO BE PASSED PER IMDQ 9/7/06 "RTN","VAFCSB",212,0) N TEAM,PD1 "RTN","VAFCSB",213,0) S PD1="" "RTN","VAFCSB",214,0) ;S TEAM=$$PREF^DGENPTA(DFN) "RTN","VAFCSB",215,0) ;I TEAM'="" S PD1="PD1"_HL("FS")_HL("FS")_HL("FS")_$$STA^XUAF4(TEAM) "RTN","VAFCSB",216,0) Q PD1 "RTN","VAFCSB",217,0) ; "RTN","VAFCSB",218,0) PV1() ;BUILD PV1 SEGMENT "RTN","VAFCSB",219,0) ;CURRENTLY ADMITTED? "RTN","VAFCSB",220,0) N PV1,VAINDT "RTN","VAFCSB",221,0) S PV1="" "RTN","VAFCSB",222,0) S VAINDT=DT "RTN","VAFCSB",223,0) D INP^VADPT "RTN","VAFCSB",224,0) I $G(VAIN(1))'="" S $P(PV1,HL("FS"),44)=$$HLDATE^HLFNC($P(VAIN(7),"^")),PV1="PV1"_HL("FS")_PV1 "RTN","VAFCSB",225,0) K VAIN "RTN","VAFCSB",226,0) Q PV1 "RTN","VAFCSB",227,0) ; "RTN","VAFCTR") 0^5^B12937603^B6623304 "RTN","VAFCTR",1,0) VAFCTR ;BIR/CMC,ERC,PTD-Monitoring fields for MPI/PD via DG field monitoring ; 1/31/17 11:04am "RTN","VAFCTR",2,0) ;;5.3;Registration;**575,648,653,712,876,902,926,937,944,967,1059**;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) ; .352 DEATH ENTERED BY **902 MVI_4735 (jfw) "RTN","VAFCTR",21,0) ; .353 SOURCE OF NOTIFICATION **902 MVI_4735 (jfw) "RTN","VAFCTR",22,0) ; .354 DATE OF DEATH LAST UPDATED **902 MVI_4735 (jfw) "RTN","VAFCTR",23,0) ; .355 LAST EDITED BY **902 MVI_4735 (jfw) "RTN","VAFCTR",24,0) ; .357 SUPPORTING DOCUMENT TYPE **926 STORY 323008 (jfw) "RTN","VAFCTR",25,0) ; .2405 PREFERRED NAME **937 STORY 445457 [Sub-Story 455414] (jfw) "RTN","VAFCTR",26,0) ; .0931 PLACE OF BIRTH COUNTRY **944 STORY 504382 [Sub-Story 513042] (jfw) "RTN","VAFCTR",27,0) ; .0932 PLACE OF BIRTH PROVINCE **944 STORY 504382 [Sub-Story 513042] (jfw) "RTN","VAFCTR",28,0) ; "RTN","VAFCTR",29,0) ;**967 STORY #783361 Sensitivity (jfw) "RTN","VAFCTR",30,0) ; DG SECURITY LOG File #38.1 monitored field: "RTN","VAFCTR",31,0) ; Note: .01 is DINUMED to the PATIENT File #2 "RTN","VAFCTR",32,0) ; 2 SECURITY LEVEL "RTN","VAFCTR",33,0) ; "RTN","VAFCTR",34,0) ;**1059 STORY VAMPI-11114, VAMPI-11118, VAMPI-11120, VAMPI-11121 (jfw) "RTN","VAFCTR",35,0) ; .025 SEXUAL ORIENTATION - .01 of the multiple "RTN","VAFCTR",36,0) ; .2406 PRONOUN - .01 of the multiple "RTN","VAFCTR",37,0) ; .0251 SEXUAL ORIENTATION DESCRIPTION "RTN","VAFCTR",38,0) ; .1151 RESIDENTIAL ADDRESS [LINE 1] "RTN","VAFCTR",39,0) ; .1152 RESIDENTIAL ADDRESS [LINE 2] "RTN","VAFCTR",40,0) ; .1153 RESIDENTIAL ADDRESS [LINE 3] "RTN","VAFCTR",41,0) ; .1154 RESIDENTIAL CITY "RTN","VAFCTR",42,0) ; .1155 RESIDENTIAL STATE "RTN","VAFCTR",43,0) ; .1156 RESIDENTIAL ZIP+4 "RTN","VAFCTR",44,0) ; .11571 RESIDENTIAL PROVINCE "RTN","VAFCTR",45,0) ; .11572 RESIDENTIAL POSTAL CODE "RTN","VAFCTR",46,0) ; .11573 RESIDENTIAL COUNTRY "RTN","VAFCTR",47,0) ; .24061 PRONOUN DESCRIPTION "RTN","VAFCTR",48,0) ; 991.11 INDIVIDUAL TAX ID "RTN","VAFCTR",49,0) ; "RTN","VAFCTR",50,0) N MVIRSLT "RTN","VAFCTR",51,0) I $G(DGFILE)'=2&($G(DGFILE)'=2.01)&($G(DGFILE)'=2.02)&($G(DGFILE)'=2.06)&($G(DGFILE)'=38.1)&($G(DGFILE)'=2.025)&($G(DGFILE)'=2.2406) Q "RTN","VAFCTR",52,0) S DGFIELD=$G(DGFIELD) "RTN","VAFCTR",53,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",54,0) ;**902 MVI_4735 (jfw) Add 4 new fields to list (Break apart long If line above) "RTN","VAFCTR",55,0) S MVIRSLT=(DGFIELD'=.01)&(DGFIELD'=994)&(DGFIELD'=.525)&(DGFIELD'=.0906)&(DGFIELD'=.121)&(DGFIELD'=.133) "RTN","VAFCTR",56,0) S MVIRSLT=MVIRSLT&(DGFIELD'=.134)&(DGFIELD'=391)&(DGFIELD'=1901)&(DGFIELD'=.323)&(DGFIELD'=.024) "RTN","VAFCTR",57,0) S MVIRSLT=MVIRSLT&(DGFIELD'=.352)&(DGFIELD'=.353)&(DGFIELD'=.354)&(DGFIELD'=.355)&(DGFIELD'=.357) "RTN","VAFCTR",58,0) S MVIRSLT=MVIRSLT&(DGFIELD'=.2405)&(DGFIELD'=.0931)&(DGFIELD'=.0932)&(DGFIELD'=2)&(DGFIELD'=.0251) "RTN","VAFCTR",59,0) S MVIRSLT=MVIRSLT&(DGFIELD'=.1151)&(DGFIELD'=.1152)&(DGFIELD'=.1153)&(DGFIELD'=.1154)&(DGFIELD'=.1155) "RTN","VAFCTR",60,0) S MVIRSLT=MVIRSLT&(DGFIELD'=.1156)&(DGFIELD'=.11571)&(DGFIELD'=.11572)&(DGFIELD'=.11573)&(DGFIELD'=.24061) "RTN","VAFCTR",61,0) S MVIRSLT=MVIRSLT&(DGFIELD'=991.11) "RTN","VAFCTR",62,0) Q:(MVIRSLT) "RTN","VAFCTR",63,0) I $T(AVAFC^VAFCDD01)="" Q "RTN","VAFCTR",64,0) ;The fields below are not multiples "RTN","VAFCTR",65,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",66,0) ;**902 MVI_4735 (jfw) Add 4 new fields to list (Break apart long If line above) "RTN","VAFCTR",67,0) S MVIRSLT=(DGFIELD=994)!(DGFIELD=.525)!(DGFIELD=.0906)!(DGFIELD=.121)!(DGFIELD=.133) "RTN","VAFCTR",68,0) S MVIRSLT=MVIRSLT!(DGFIELD=.134)!(DGFIELD=.024)!(DGFIELD=391)!(DGFIELD=1901)!(DGFIELD=.323) "RTN","VAFCTR",69,0) S MVIRSLT=MVIRSLT!(DGFIELD=.352)!(DGFIELD=.353)!(DGFIELD=.354)!(DGFIELD=.355)!(DGFIELD=.357) "RTN","VAFCTR",70,0) S MVIRSLT=MVIRSLT!(DGFIELD=.2405)!(DGFIELD=.0931)!(DGFIELD=.0932)!(DGFIELD=.0251)!(DGFIELD=.1151) "RTN","VAFCTR",71,0) S MVIRSLT=MVIRSLT!(DGFIELD=.1152)!(DGFIELD=.1153)!(DGFIELD=.1154)!(DGFIELD=.1155)!(DGFIELD=.1156) "RTN","VAFCTR",72,0) S MVIRSLT=MVIRSLT!(DGFIELD=.11571)!(DGFIELD=.11572)!(DGFIELD=.11573)!(DGFIELD=.24061)!(DGFIELD=991.11) "RTN","VAFCTR",73,0) I MVIRSLT S VAFCF=DGFIELD_";" D AVAFC^VAFCDD01(DGDA) "RTN","VAFCTR",74,0) ;The fields below ARE multiples "RTN","VAFCTR",75,0) I DGFILE=2.01 S VAFCF="1;" D AVAFC^VAFCDD01(DGDA(1)) ;ALIAS "RTN","VAFCTR",76,0) I DGFILE=2.02 S VAFCF="2.02,.01;" D AVAFC^VAFCDD01(DGDA(1)) ;RACE INFORMATION "RTN","VAFCTR",77,0) I DGFILE=2.06 S VAFCF="2.06,.01;" D AVAFC^VAFCDD01(DGDA(1)) ;ETHNICITY INFORMATION "RTN","VAFCTR",78,0) I DGFILE=2.025 S VAFCF="2.025,.01;" D AVAFC^VAFCDD01(DGDA(1)) ;SEXUAL ORIENTATION "RTN","VAFCTR",79,0) I DGFILE=2.2406 S VAFCF="2.2406,.01;" D AVAFC^VAFCDD01(DGDA(1)) ;PRONOUN "RTN","VAFCTR",80,0) ;Process field for different File **967 (jfw) "RTN","VAFCTR",81,0) I DGFILE=38.1 S VAFCF="38.1,2;" D AVAFC^VAFCDD01(DGDA) ;Sensitivity Info "RTN","VAFCTR",82,0) Q "SEC","^DIC",47.77,47.77,0,"AUDIT") @ "SEC","^DIC",47.77,47.77,0,"DD") @ "SEC","^DIC",47.77,47.77,0,"DEL") @ "SEC","^DIC",47.77,47.77,0,"LAYGO") @ "SEC","^DIC",47.77,47.77,0,"RD") @ "SEC","^DIC",47.77,47.77,0,"WR") @ "SEC","^DIC",47.78,47.78,0,"AUDIT") @ "SEC","^DIC",47.78,47.78,0,"DD") @ "SEC","^DIC",47.78,47.78,0,"DEL") @ "SEC","^DIC",47.78,47.78,0,"LAYGO") @ "SEC","^DIC",47.78,47.78,0,"RD") @ "SEC","^DIC",47.78,47.78,0,"WR") @ "UP",2,2.025,-1) 2^.025 "UP",2,2.025,0) 2.025 "UP",2,2.2406,-1) 2^.2406 "UP",2,2.2406,0) 2.2406 "VER") 8.0^22.2 "^DD",2,2,.025,0) SEXUAL ORIENTATION^2.025P^^.025;0 "^DD",2,2,.025,21,0) ^^2^2^3210628^ "^DD",2,2,.025,21,1,0) The Sexual Orientation identifies the identities of the patient in "^DD",2,2,.025,21,2,0) relation to the gender to which they associate with. "^DD",2,2,.0251,0) SEXUAL ORIENTATION DESCRIPTION^FJ255a^^.241;1^K:$L(X)>255!($L(X)<3) X "^DD",2,2,.0251,3) Enter the description (3-255 characters) of the specified 'Other' Sexual Orientation associated with the patient. "^DD",2,2,.0251,21,0) ^.001^3^3^3210628^^ "^DD",2,2,.0251,21,1,0) The SEXUAL ORIENTATION DESCRIPTION field defines the 'Other' specified "^DD",2,2,.0251,21,2,0) Sexual Orientation identity of the patient in relation to the gender to "^DD",2,2,.0251,21,3,0) which they associate with. "^DD",2,2,.0251,"AUDIT") y "^DD",2,2,.0251,"DT") 3210628 "^DD",2,2,.1151,0) RESIDENTIAL ADDRESS [LINE 1]^FJ35Xa^^.115;1^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>35!($L(X)<3) X D:$D(X) UP^DGHELP "^DD",2,2,.1151,1,0) ^.1 "^DD",2,2,.1151,1,1,0) ^^TRIGGER^2^.1152 "^DD",2,2,.1151,1,1,1) Q "^DD",2,2,.1151,1,1,2) K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S Y(1)=$S($D(^DPT(D0,.115)):^(.115),1:"") S X=$P(Y(1),U,1)="" I X S X=DIV S Y(1)=$S($D(^DPT(D0,.115)):^(.115),1:"") S X=$P(Y(1),U,2),X=X S DIU=X K Y S X="" X ^DD(2,.1151,1,1,2.4) "^DD",2,2,.1151,1,1,2.4) S DIH=$G(^DPT(DIV(0),.115)),DIV=X S $P(^(.115),U,2)=DIV,DIH=2,DIG=.1152 D ^DICR "^DD",2,2,.1151,1,1,"%D",0) ^^2^2^3180216^ "^DD",2,2,.1151,1,1,"%D",1,0) This cross-reference will delete the contents of RESIDENTIAL ADDRESS "^DD",2,2,.1151,1,1,"%D",2,0) [LINE 2] whenever this field is deleted. "^DD",2,2,.1151,1,1,"CREATE VALUE") NO EFFECT "^DD",2,2,.1151,1,1,"DELETE CONDITION") RESIDENTIAL ADDRESS [LINE 1]="" "^DD",2,2,.1151,1,1,"DELETE VALUE") @ "^DD",2,2,.1151,1,1,"DT") 3180216 "^DD",2,2,.1151,1,1,"FIELD") RESIDENTIAL ADDRESS [LINE 2] "^DD",2,2,.1151,1,2,0) 2^AENR1151^MUMPS "^DD",2,2,.1151,1,2,1) D EVENT^IVMPLOG(DA) "^DD",2,2,.1151,1,2,2) D EVENT^IVMPLOG(DA) "^DD",2,2,.1151,1,2,3) DO NOT DELETE "^DD",2,2,.1151,1,2,"%D",0) ^.101^2^2^3180215^^^ "^DD",2,2,.1151,1,2,"%D",1,0) This cross-reference is used to notify HEC of changes that may affect "^DD",2,2,.1151,1,2,"%D",2,0) enrollment. "^DD",2,2,.1151,1,2,"DT") 3171219 "^DD",2,2,.1151,1,301,0) 2^AIVM1151^MUMPS "^DD",2,2,.1151,1,301,1) D DPT^IVMPXFR "^DD",2,2,.1151,1,301,2) D DPT^IVMPXFR "^DD",2,2,.1151,1,301,"%D",0) ^.101^4^4^3171226^^^ "^DD",2,2,.1151,1,301,"%D",1,0) This cross-reference will check the IVM PATIENT file to see if a change "^DD",2,2,.1151,1,301,"%D",2,0) to this field will require transmission to the IVM Center. If it does, "^DD",2,2,.1151,1,301,"%D",3,0) the IVM PATIENT file entry's TRANSMISSION STATUS will be set to 0 and "^DD",2,2,.1151,1,301,"%D",4,0) the nightly background job will transmit the updated information. "^DD",2,2,.1151,1,301,"DT") 3171226 "^DD",2,2,.1151,3) Answer must be 3-35 characters in length. "^DD",2,2,.1151,21,0) ^.001^1^1^3180420^^^^ "^DD",2,2,.1151,21,1,0) This is the first line of this applicant's residential address "^DD",2,2,.1151,"AUDIT") y "^DD",2,2,.1151,"DT") 3210713 "^DD",2,2,.1152,0) RESIDENTIAL ADDRESS [LINE 2]^FJ30aX^^.115;2^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>30!($L(X)<3) X D:$D(X) UP^DGHELP "^DD",2,2,.1152,1,0) ^.1 "^DD",2,2,.1152,1,1,0) 2^AENR1152^MUMPS "^DD",2,2,.1152,1,1,1) D EVENT^IVMPLOG(DA) "^DD",2,2,.1152,1,1,2) D EVENT^IVMPLOG(DA) "^DD",2,2,.1152,1,1,3) DO NOT DELETE "^DD",2,2,.1152,1,1,"%D",0) ^.101^2^2^3171219^^ "^DD",2,2,.1152,1,1,"%D",1,0) This cross-reference is used to notify HEC of changes that may affect "^DD",2,2,.1152,1,1,"%D",2,0) enrollment. "^DD",2,2,.1152,1,1,"DT") 3171219 "^DD",2,2,.1152,1,2,0) ^^TRIGGER^2^.1153 "^DD",2,2,.1152,1,2,1) Q "^DD",2,2,.1152,1,2,2) K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(0)=X S Y(1)=$S($D(^DPT(D0,.115)):^(.115),1:"") S X=$P(Y(1),U,2)="" I X S X=DIV S Y(1)=$S($D(^DPT(D0,.115)):^(.115),1:"") S X=$P(Y(1),U,3),X=X S DIU=X K Y S X="" X ^DD(2,.1152,1,2,2.4) "^DD",2,2,.1152,1,2,2.4) S DIH=$G(^DPT(DIV(0),.115)),DIV=X S $P(^(.115),U,3)=DIV,DIH=2,DIG=.1153 D ^DICR "^DD",2,2,.1152,1,2,"%D",0) ^^2^2^3180216^ "^DD",2,2,.1152,1,2,"%D",1,0) This cross-reference will delete the contents of RESIDENTIAL ADDRESS "^DD",2,2,.1152,1,2,"%D",2,0) [LINE 3] whenever this field is deleted. "^DD",2,2,.1152,1,2,"CREATE VALUE") NO EFFECT "^DD",2,2,.1152,1,2,"DELETE CONDITION") RESIDENTIAL ADDRESS [LINE 2]="" "^DD",2,2,.1152,1,2,"DELETE VALUE") @ "^DD",2,2,.1152,1,2,"DT") 3180216 "^DD",2,2,.1152,1,2,"FIELD") RESIDENTIAL ADDRESS [LINE 3] "^DD",2,2,.1152,1,301,0) 2^AIVM1152^MUMPS "^DD",2,2,.1152,1,301,1) D DPT^IVMPXFR "^DD",2,2,.1152,1,301,2) D DPT^IVMPXFR "^DD",2,2,.1152,1,301,"%D",0) ^.101^4^4^3171226^^ "^DD",2,2,.1152,1,301,"%D",1,0) This cross-reference will check the IVM PATIENT file to see if a change "^DD",2,2,.1152,1,301,"%D",2,0) to this field will require transmission to the IVM Center. If it does, "^DD",2,2,.1152,1,301,"%D",3,0) the IVM PATIENT file entry's TRANSMISSION STATUS will be set to 0 and "^DD",2,2,.1152,1,301,"%D",4,0) the nightly background job will transmit the updated information. "^DD",2,2,.1152,1,301,"DT") 3171226 "^DD",2,2,.1152,3) Answer must be 3-30 characters in length. "^DD",2,2,.1152,5,1,0) 2^.1151^1 "^DD",2,2,.1152,21,0) ^.001^3^3^3180212^^ "^DD",2,2,.1152,21,1,0) This is the second line of this applicant's residential address [3-30 "^DD",2,2,.1152,21,2,0) characters] if the space provided in 'residential address [Line 1]' was "^DD",2,2,.1152,21,3,0) not sufficient. "^DD",2,2,.1152,"AUDIT") y "^DD",2,2,.1152,"DT") 3210713 "^DD",2,2,.1153,0) RESIDENTIAL ADDRESS [LINE 3]^FJ30aX^^.115;3^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>30!($L(X)<3) X D:$D(X) UP^DGHELP "^DD",2,2,.1153,1,0) ^.1 "^DD",2,2,.1153,1,1,0) 2^AENR1153^MUMPS "^DD",2,2,.1153,1,1,1) D EVENT^IVMPLOG(DA) "^DD",2,2,.1153,1,1,2) D EVENT^IVMPLOG(DA) "^DD",2,2,.1153,1,1,3) DO NOT DELETE "^DD",2,2,.1153,1,1,"%D",0) ^^2^2^3171219^ "^DD",2,2,.1153,1,1,"%D",1,0) This cross-reference is used to notify HEC of changes that may affect "^DD",2,2,.1153,1,1,"%D",2,0) enrollment. "^DD",2,2,.1153,1,1,"DT") 3171219 "^DD",2,2,.1153,1,301,0) 2^AIVM1153^MUMPS "^DD",2,2,.1153,1,301,1) D DPT^IVMPXFR "^DD",2,2,.1153,1,301,2) D DPT^IVMPXFR "^DD",2,2,.1153,1,301,"%D",0) ^.101^4^4^3171226^^ "^DD",2,2,.1153,1,301,"%D",1,0) This cross-reference will check the IVM PATIENT file to see if a change "^DD",2,2,.1153,1,301,"%D",2,0) to this field will require transmission to the IVM Center. If it does, "^DD",2,2,.1153,1,301,"%D",3,0) the IVM PATIENT file entry's TRANSMISSION STATUS will be set to 0 and "^DD",2,2,.1153,1,301,"%D",4,0) the nightly background job will transmit the updated information. "^DD",2,2,.1153,1,301,"DT") 3171226 "^DD",2,2,.1153,3) Answer must be 3-30 characters in length. "^DD",2,2,.1153,5,1,0) 2^.1152^2 "^DD",2,2,.1153,21,0) ^^3^3^3180201^ "^DD",2,2,.1153,21,1,0) This is the third line of this applicant's residential address "^DD",2,2,.1153,21,2,0) [3-30 characters] if the space provided in 'residential address [Line 1]' "^DD",2,2,.1153,21,3,0) and 'residential address [Line 2]' was not sufficient. "^DD",2,2,.1153,"AUDIT") y "^DD",2,2,.1153,"DT") 3210713 "^DD",2,2,.1154,0) RESIDENTIAL CITY^FJ15aX^^.115;4^K:$L(X)>15!($L(X)<2) X D:$D(X) UP^DGHELP "^DD",2,2,.1154,1,0) ^.1 "^DD",2,2,.1154,1,1,0) 2^AENR1154^MUMPS "^DD",2,2,.1154,1,1,1) D EVENT^IVMPLOG(DA) "^DD",2,2,.1154,1,1,2) D EVENT^IVMPLOG(DA) "^DD",2,2,.1154,1,1,3) DO NOT DELETE "^DD",2,2,.1154,1,1,"%D",0) ^^2^2^3171219^ "^DD",2,2,.1154,1,1,"%D",1,0) This cross-reference is used to notify HEC of changes that may affect "^DD",2,2,.1154,1,1,"%D",2,0) enrollment. "^DD",2,2,.1154,1,1,"DT") 3171219 "^DD",2,2,.1154,1,301,0) 2^AIVM1154^MUMPS "^DD",2,2,.1154,1,301,1) D DPT^IVMPXFR "^DD",2,2,.1154,1,301,2) D DPT^IVMPXFR "^DD",2,2,.1154,1,301,"%D",0) ^.101^4^4^3180215^^^ "^DD",2,2,.1154,1,301,"%D",1,0) This cross-reference will check the IVM PATIENT file to see if a change "^DD",2,2,.1154,1,301,"%D",2,0) to this field will require transmission to the IVM Center. If it does, "^DD",2,2,.1154,1,301,"%D",3,0) the IVM PATIENT file entry's TRANSMISSION STATUS will be set to 0 and "^DD",2,2,.1154,1,301,"%D",4,0) the nightly background job will transmit the updated information. "^DD",2,2,.1154,1,301,"DT") 3180215 "^DD",2,2,.1154,3) Answer must be 2-15 characters in length. "^DD",2,2,.1154,21,0) ^.001^1^1^3180213^^^^ "^DD",2,2,.1154,21,1,0) This is the city in which this applicant resides "^DD",2,2,.1154,"AUDIT") y "^DD",2,2,.1154,"DT") 3210713 "^DD",2,2,.1155,0) RESIDENTIAL STATE^P5'a^DIC(5,^.115;5^Q "^DD",2,2,.1155,1,0) ^.1 "^DD",2,2,.1155,1,1,0) 2^AENR1155^MUMPS "^DD",2,2,.1155,1,1,1) D EVENT^IVMPLOG(DA) "^DD",2,2,.1155,1,1,2) D EVENT^IVMPLOG(DA) "^DD",2,2,.1155,1,1,3) DO NOT DELETE "^DD",2,2,.1155,1,1,"%D",0) ^^2^2^3171219^ "^DD",2,2,.1155,1,1,"%D",1,0) This cross-reference is used to notify HEC of changes that may affect "^DD",2,2,.1155,1,1,"%D",2,0) enrollment. "^DD",2,2,.1155,1,1,"DT") 3171219 "^DD",2,2,.1155,1,301,0) 2^AIVM1155^MUMPS "^DD",2,2,.1155,1,301,1) D DPT^IVMPXFR "^DD",2,2,.1155,1,301,2) D DPT^IVMPXFR "^DD",2,2,.1155,1,301,"%D",0) ^.101^4^4^3171226^^ "^DD",2,2,.1155,1,301,"%D",1,0) This cross-reference will check the IVM PATIENT file to see if a change "^DD",2,2,.1155,1,301,"%D",2,0) to this field will require transmission to the IVM Center. If it does, "^DD",2,2,.1155,1,301,"%D",3,0) the IVM PATIENT file entry's TRANSMISSION STATUS will be set to 0 and "^DD",2,2,.1155,1,301,"%D",4,0) the nightly background job will transmit the updated information. "^DD",2,2,.1155,1,301,"DT") 3171226 "^DD",2,2,.1155,3) Select from the available listing the state in which this applicant resides. "^DD",2,2,.1155,21,0) ^.001^1^1^3180213^^^^ "^DD",2,2,.1155,21,1,0) This is the state in which this applicant resides "^DD",2,2,.1155,"AUDIT") y "^DD",2,2,.1155,"DT") 3210713 "^DD",2,2,.1156,0) RESIDENTIAL ZIP+4^FaXJ20O^^.115;6^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>20!($L(X)<5) X I $D(X) D ZIPIN^VAFADDR "^DD",2,2,.1156,1,0) ^.1 "^DD",2,2,.1156,1,1,0) 2^AENR1156^MUMPS "^DD",2,2,.1156,1,1,1) D EVENT^IVMPLOG(DA) "^DD",2,2,.1156,1,1,2) D EVENT^IVMPLOG(DA) "^DD",2,2,.1156,1,1,3) DO NOT DELETE "^DD",2,2,.1156,1,1,"%D",0) ^^2^2^3171219^ "^DD",2,2,.1156,1,1,"%D",1,0) This cross-reference is used to notify HEC of changes that may affect "^DD",2,2,.1156,1,1,"%D",2,0) enrollment. "^DD",2,2,.1156,1,1,"DT") 3171219 "^DD",2,2,.1156,1,301,0) 2^AIVM1156^MUMPS "^DD",2,2,.1156,1,301,1) D DPT^IVMPXFR "^DD",2,2,.1156,1,301,2) D DPT^IVMPXFR "^DD",2,2,.1156,1,301,"%D",0) ^.101^4^4^3171226^^ "^DD",2,2,.1156,1,301,"%D",1,0) This cross-reference will check the IVM PATIENT file to see if a change "^DD",2,2,.1156,1,301,"%D",2,0) to this field will require transmission to the IVM Center. If it does, "^DD",2,2,.1156,1,301,"%D",3,0) the IVM PATIENT file entry's TRANSMISSION STATUS will be set to 0 and "^DD",2,2,.1156,1,301,"%D",4,0) the nightly background job will transmit the updated information. "^DD",2,2,.1156,1,301,"DT") 3171226 "^DD",2,2,.1156,2) S Y(0)=Y D ZIPOUT^VAFADDR "^DD",2,2,.1156,2.1) D ZIPOUT^VAFADDR "^DD",2,2,.1156,3) Answer with either 5 digit or 9 digit zip code. "^DD",2,2,.1156,20,0) ^.3LA^1^1 "^DD",2,2,.1156,20,1,0) DEMOG "^DD",2,2,.1156,21,0) ^.001^1^1^3180213^^^^ "^DD",2,2,.1156,21,1,0) This is the zip code for the city in which this applicant resides "^DD",2,2,.1156,"AUDIT") y "^DD",2,2,.1156,"DT") 3210713 "^DD",2,2,.11571,0) RESIDENTIAL PROVINCE^FaXJ20^^.115;8^K:$L(X)>20!($L(X)<1) X D:$D(X) UP^DGHELP "^DD",2,2,.11571,3) Answer must be 1-20 characters in length. "^DD",2,2,.11571,21,0) ^.001^1^1^3151218^^ "^DD",2,2,.11571,21,1,0) This is the Province for a foreign residential address "^DD",2,2,.11571,"AUDIT") y "^DD",2,2,.11571,"DT") 3210713 "^DD",2,2,.11572,0) RESIDENTIAL POSTAL CODE^FaXJ10^^.115;9^K:$L(X)>10!($L(X)<1) X D:$D(X) UP^DGHELP "^DD",2,2,.11572,3) Answer must be 1-10 characters in length. "^DD",2,2,.11572,21,0) ^.001^1^1^3151218^^ "^DD",2,2,.11572,21,1,0) This is the Postal Code for a patient which has a foreign address. "^DD",2,2,.11572,"AUDIT") y "^DD",2,2,.11572,"DT") 3210713 "^DD",2,2,.11573,0) RESIDENTIAL COUNTRY^P779.004'a^HL(779.004,^.115;10^Q "^DD",2,2,.11573,3) Enter the country where the patient's residential address is located. If entering an Army/Air Force Post Office (APO) or a Fleet Post Office (FPO) address select United States as the country. "^DD",2,2,.11573,21,0) ^.001^1^1^3180215^^^^ "^DD",2,2,.11573,21,1,0) This is the country where the patient's residential address is located. "^DD",2,2,.11573,"AUDIT") y "^DD",2,2,.11573,"DT") 3210713 "^DD",2,2,.2406,0) PRONOUN^2.2406P^^.2406;0 "^DD",2,2,.2406,21,0) ^^1^1^3210628^ "^DD",2,2,.2406,21,1,0) The Pronoun(s) identify how the patient should be addressed. "^DD",2,2,.24061,0) PRONOUN DESCRIPTION^FJ255a^^.241;2^K:$L(X)>255!($L(X)<3) X "^DD",2,2,.24061,3) Enter the description (3-255 characters) of the 'Other' Pronoun for specifically addressing the patient. "^DD",2,2,.24061,21,0) ^.001^2^2^3210623^^ "^DD",2,2,.24061,21,1,0) The PRONOUN DESCRIPTION field defines the selected 'Other' Pronoun for "^DD",2,2,.24061,21,2,0) specifically addressing the patient. "^DD",2,2,.24061,"AUDIT") y "^DD",2,2,.24061,"DT") 3210624 "^DD",2,2,991.11,0) INDIVIDUAL TAX ID^NJ9,0a^^MPI;11^K:+X'=X!(X>999999999)!(X<900000000)!(X?.E1"."1N.N) X "^DD",2,2,991.11,3) Enter the Individual Tax Identification Number (900000000-999999999) for the patient. "^DD",2,2,991.11,21,0) ^^5^5^3210624^ "^DD",2,2,991.11,21,1,0) An ITIN or Individual Taxpayer Identification Number, is a tax processing "^DD",2,2,991.11,21,2,0) number only available for certain non-resident and resident aliens, their "^DD",2,2,991.11,21,3,0) spouses and dependents who cannot get a Social Security Number (SSN). It "^DD",2,2,991.11,21,4,0) is a 9-digit number, beginning with the number '9', formatted like an SSN "^DD",2,2,991.11,21,5,0) (NNN-NN-NNNN). "^DD",2,2,991.11,"AUDIT") y "^DD",2,2,991.11,"DT") 3210624 "^DD",2,2.025,0) SEXUAL ORIENTATION SUB-FIELD^^.01^1 "^DD",2,2.025,0,"NM","SEXUAL ORIENTATION") "^DD",2,2.025,.01,0) SEXUAL ORIENTATION^MP47.77'a^DG(47.77,^0;1^Q "^DD",2,2.025,.01,1,0) ^.1 "^DD",2,2.025,.01,1,1,0) 2.025^B "^DD",2,2.025,.01,1,1,1) S ^DPT(DA(1),.025,"B",$E(X,1,30),DA)="" "^DD",2,2.025,.01,1,1,2) K ^DPT(DA(1),.025,"B",$E(X,1,30),DA) "^DD",2,2.025,.01,3) Select the appropriate SEXUAL ORIENTATION TYPE from the list that identifies the identity of the patient in relation to the gender to which they associate with. "^DD",2,2.025,.01,21,0) ^^2^2^3210628^ "^DD",2,2.025,.01,21,1,0) The Sexual Orientation selected from the available list identifies the "^DD",2,2.025,.01,21,2,0) identity in relation to the gender to which the patient associates with. "^DD",2,2.025,.01,"AUDIT") y "^DD",2,2.025,.01,"DT") 3210628 "^DD",2,2.2406,0) PRONOUN SUB-FIELD^^.01^1 "^DD",2,2.2406,0,"NM","PRONOUN") "^DD",2,2.2406,.01,0) PRONOUN^MP47.78'a^DG(47.78,^0;1^Q "^DD",2,2.2406,.01,1,0) ^.1 "^DD",2,2.2406,.01,1,1,0) 2.2406^B "^DD",2,2.2406,.01,1,1,1) S ^DPT(DA(1),.2406,"B",$E(X,1,30),DA)="" "^DD",2,2.2406,.01,1,1,2) K ^DPT(DA(1),.2406,"B",$E(X,1,30),DA) "^DD",2,2.2406,.01,3) Select the appropriate PRONOUN TYPE from the list that identifies how the patient should be addressed. "^DD",2,2.2406,.01,21,0) ^^2^2^3210628^ "^DD",2,2.2406,.01,21,1,0) The Pronoun selected from the available list identifies how the patient "^DD",2,2.2406,.01,21,2,0) should be addressed. "^DD",2,2.2406,.01,"AUDIT") y "^DD",2,2.2406,.01,"DT") 3210628 "^DD",47.77,47.77,0) FIELD^^1^2 "^DD",47.77,47.77,0,"DT") 3211014 "^DD",47.77,47.77,0,"IX","B",47.77,.01) "^DD",47.77,47.77,0,"IX","C",47.77,1) "^DD",47.77,47.77,0,"NM","SEXUAL ORIENTATION TYPES") "^DD",47.77,47.77,0,"PT",2.025,.01) "^DD",47.77,47.77,0,"VRPK") DG "^DD",47.77,47.77,.01,0) SEXUAL ORIENTATION TYPE^RFJ50^^0;1^K:$L(X)>50!($L(X)<3)!'(X'?1P.E) X "^DD",47.77,47.77,.01,1,0) ^.1 "^DD",47.77,47.77,.01,1,1,0) 47.77^B "^DD",47.77,47.77,.01,1,1,1) S ^DG(47.77,"B",$E(X,1,50),DA)="" "^DD",47.77,47.77,.01,1,1,2) K ^DG(47.77,"B",$E(X,1,50),DA) "^DD",47.77,47.77,.01,3) Enter the Sexual Orientation (3-50 characters) that identifies a patient's identity in relation to the gender to which they identify with. "^DD",47.77,47.77,.01,21,0) ^.001^2^2^3210624^^^ "^DD",47.77,47.77,.01,21,1,0) The SEXUAL ORIENTATION TYPE field identifies the identity of the patient "^DD",47.77,47.77,.01,21,2,0) in relation to the gender to which they identify with. "^DD",47.77,47.77,.01,"DT") 3210624 "^DD",47.77,47.77,1,0) TYPE CODE^RFJ5^^0;2^K:$L(X)>5!($L(X)<1) X "^DD",47.77,47.77,1,1,0) ^.1 "^DD",47.77,47.77,1,1,1,0) 47.77^C "^DD",47.77,47.77,1,1,1,1) S ^DG(47.77,"C",$E(X,1,30),DA)="" "^DD",47.77,47.77,1,1,1,2) K ^DG(47.77,"C",$E(X,1,30),DA) "^DD",47.77,47.77,1,1,1,"%D",0) ^^3^3^3210623^ "^DD",47.77,47.77,1,1,1,"%D",1,0) This cross-reference creates an index of all the TYPE CODEs so that they "^DD",47.77,47.77,1,1,1,"%D",2,0) can be used as a lookup to retrieve the full name value of the SEXUAL "^DD",47.77,47.77,1,1,1,"%D",3,0) ORIENTATION TYPE field. "^DD",47.77,47.77,1,1,1,"DT") 3210623 "^DD",47.77,47.77,1,3) Enter the code (1-5 characters) associated with the SEXUAL ORIENTATION TYPE. "^DD",47.77,47.77,1,21,0) ^^1^1^3210623^ "^DD",47.77,47.77,1,21,1,0) This code uniquely identifies the SEXUAL ORIENTATION TYPE record. "^DD",47.77,47.77,1,"DT") 3210623 "^DD",47.78,47.78,0) FIELD^^1^2 "^DD",47.78,47.78,0,"DT") 3211014 "^DD",47.78,47.78,0,"IX","B",47.78,.01) "^DD",47.78,47.78,0,"IX","C",47.78,1) "^DD",47.78,47.78,0,"NM","PRONOUN TYPES") "^DD",47.78,47.78,0,"PT",2.2406,.01) "^DD",47.78,47.78,0,"VRPK") DG "^DD",47.78,47.78,.01,0) PRONOUN TYPE^RFJ25^^0;1^K:$L(X)>25!($L(X)<3)!'(X'?1P.E) X "^DD",47.78,47.78,.01,1,0) ^.1 "^DD",47.78,47.78,.01,1,1,0) 47.78^B "^DD",47.78,47.78,.01,1,1,1) S ^DG(47.78,"B",$E(X,1,30),DA)="" "^DD",47.78,47.78,.01,1,1,2) K ^DG(47.78,"B",$E(X,1,30),DA) "^DD",47.78,47.78,.01,3) Enter the Pronoun (3-25 characters) that a patient can be addressed as. "^DD",47.78,47.78,.01,21,0) ^.001^2^2^3210624^^^ "^DD",47.78,47.78,.01,21,1,0) The PRONOUN TYPE field specifies the appropriate noun that a patient has "^DD",47.78,47.78,.01,21,2,0) requested to be addressed as. "^DD",47.78,47.78,.01,"DT") 3210624 "^DD",47.78,47.78,1,0) TYPE CODE^RFJ5^^0;2^K:$L(X)>5!($L(X)<1) X "^DD",47.78,47.78,1,1,0) ^.1 "^DD",47.78,47.78,1,1,1,0) 47.78^C "^DD",47.78,47.78,1,1,1,1) S ^DG(47.78,"C",$E(X,1,30),DA)="" "^DD",47.78,47.78,1,1,1,2) K ^DG(47.78,"C",$E(X,1,30),DA) "^DD",47.78,47.78,1,1,1,"%D",0) ^.101^3^3^3210714^^ "^DD",47.78,47.78,1,1,1,"%D",1,0) This cross-reference creates an index of all the TYPE CODEs so that they "^DD",47.78,47.78,1,1,1,"%D",2,0) can be used as a lookup to retrieve the full name value of the PRONOUN "^DD",47.78,47.78,1,1,1,"%D",3,0) TYPE field. "^DD",47.78,47.78,1,1,1,"DT") 3210623 "^DD",47.78,47.78,1,3) Enter the code (1-5 characters) associated with the PRONOUN TYPE. "^DD",47.78,47.78,1,21,0) ^.001^1^1^3210623^^ "^DD",47.78,47.78,1,21,1,0) This code uniquely identifies the PRONOUN TYPE record. "^DD",47.78,47.78,1,"DT") 3210623 "^DIC",47.77,47.77,0) SEXUAL ORIENTATION TYPES^47.77 "^DIC",47.77,47.77,0,"GL") ^DG(47.77, "^DIC",47.77,47.77,"%D",0) ^^3^3^3210623^ "^DIC",47.77,47.77,"%D",1,0) This file contains all the allowable Sexual Orientation Types that can be "^DIC",47.77,47.77,"%D",2,0) associated to a patient's identity in relation to the gender to which "^DIC",47.77,47.77,"%D",3,0) they identify with. "^DIC",47.77,"B","SEXUAL ORIENTATION TYPES",47.77) "^DIC",47.78,47.78,0) PRONOUN TYPES^47.78 "^DIC",47.78,47.78,0,"GL") ^DG(47.78, "^DIC",47.78,47.78,"%D",0) ^^2^2^3210623^ "^DIC",47.78,47.78,"%D",1,0) This file contains all the allowable Pronoun Types that a patient can be "^DIC",47.78,47.78,"%D",2,0) addressed as. "^DIC",47.78,"B","PRONOUN TYPES",47.78) "BLD",3657,6) ^929 **END** **END**