- BDGLOC1 ; IHS/ANMC/LJF - LOCATOR CARD - print ;
- ;;5.3;PIMS;**1007**;FEB 27, 2007
- ;
- ;cmi/anch/maw 2/22/2007 added code to print attending provider PATCH 1007 item 1007.42
- ;
- EN ;EP; entry point from queuing
- Q:'$G(DFN) Q:'$G(BDGN)
- S BDGN=$P($G(^DGPM(BDGN,0)),U,14) Q:'BDGN ;make sure is admission ien
- ;
- ; -- patient demographics
- U IO W !!!?8,"***Confidential Patient Data***",!
- W ?5,$E($$GET1^DIQ(2,DFN,.01),1,25)
- W ?29,"Chart #: ",$$HRCN^BDGF2(DFN,DUZ(2))
- W !?5,"Age: ",$$GET1^DIQ(9000001,DFN,1102.98)
- W ?23,"Date of Birth: ",$$GET1^DIQ(2,DFN,.03)
- W !?5,"Sex: ",$$GET1^DIQ(2,DFN,.02,"I")
- W ?28,"Religion: ",$$GET1^DIQ(2,DFN,.08)
- ;
- ; -- mailing address
- S X=$$GET1^DIQ(2,DFN,.111)
- W !!?5,"Patient's Address: ",!
- W ?5,$$GET1^DIQ(2,DFN,.111)," ",$$GET1^DIQ(2,DFN,.114)
- W ", ",$$GET1^DIQ(5,+$$GET1^DIQ(2,DFN,.115,"I"),1) ;state abbrev
- W " ",$$GET1^DIQ(2,DFN,.116)
- ;
- ; -- next of kin
- W !!?5,"Next of Kin:"
- W !?5,$$GET1^DIQ(2,DFN,.211),?37,$$GET1^DIQ(2,DFN,.212)
- W !?5,$$GET1^DIQ(2,DFN,.213)," ",$$GET1^DIQ(2,DFN,.216)
- W $$GET1^DIQ(2,DFN,.217)
- W " ",$$GET1^DIQ(5,+$$GET1^DIQ(2,DFN,.218,"I"),1) ;state abbrev
- S X=$$GET1^DIQ(2,DFN,.219) I X]"" W !?5,"Phone: ",X
- ;
- ; -- admission info
- W !!?5,"Admission Date: "
- W ?20,$$FMTE^XLFDT(+$$GET1^DIQ(405,BDGN,.01,"I"),"P")
- I $G(^DPT(DFN,.105))=BDGN D
- . W !?8,"Ward/Room-Bed: ",$G(^DPT(DFN,.1))," / ",$G(^DPT(DFN,.101))
- ;cmi/anch/maw 2/22/2007 add attending provider if there PATCH 1007 item 1007.42
- W !,?5,"Attending Provider: "
- W ?25,$$LASTPRV^BDGF1(BDGN,DFN)
- ;cmi/anch/maw 2/22/2007 end of additions
- ;
- D ^%ZISC K DFN,BDGN
- D KILL^AUPNPAT
- Q
- ;
- BDGLOC1 ; IHS/ANMC/LJF - LOCATOR CARD - print ;
- +1 ;;5.3;PIMS;**1007**;FEB 27, 2007
- +2 ;
- +3 ;cmi/anch/maw 2/22/2007 added code to print attending provider PATCH 1007 item 1007.42
- +4 ;
- EN ;EP; entry point from queuing
- +1 IF '$GET(DFN)
- QUIT
- IF '$GET(BDGN)
- QUIT
- +2 ;make sure is admission ien
- SET BDGN=$PIECE($GET(^DGPM(BDGN,0)),U,14)
- IF 'BDGN
- QUIT
- +3 ;
- +4 ; -- patient demographics
- +5 USE IO
- WRITE !!!?8,"***Confidential Patient Data***",!
- +6 WRITE ?5,$EXTRACT($$GET1^DIQ(2,DFN,.01),1,25)
- +7 WRITE ?29,"Chart #: ",$$HRCN^BDGF2(DFN,DUZ(2))
- +8 WRITE !?5,"Age: ",$$GET1^DIQ(9000001,DFN,1102.98)
- +9 WRITE ?23,"Date of Birth: ",$$GET1^DIQ(2,DFN,.03)
- +10 WRITE !?5,"Sex: ",$$GET1^DIQ(2,DFN,.02,"I")
- +11 WRITE ?28,"Religion: ",$$GET1^DIQ(2,DFN,.08)
- +12 ;
- +13 ; -- mailing address
- +14 SET X=$$GET1^DIQ(2,DFN,.111)
- +15 WRITE !!?5,"Patient's Address: ",!
- +16 WRITE ?5,$$GET1^DIQ(2,DFN,.111)," ",$$GET1^DIQ(2,DFN,.114)
- +17 ;state abbrev
- WRITE ", ",$$GET1^DIQ(5,+$$GET1^DIQ(2,DFN,.115,"I"),1)
- +18 WRITE " ",$$GET1^DIQ(2,DFN,.116)
- +19 ;
- +20 ; -- next of kin
- +21 WRITE !!?5,"Next of Kin:"
- +22 WRITE !?5,$$GET1^DIQ(2,DFN,.211),?37,$$GET1^DIQ(2,DFN,.212)
- +23 WRITE !?5,$$GET1^DIQ(2,DFN,.213)," ",$$GET1^DIQ(2,DFN,.216)
- +24 WRITE $$GET1^DIQ(2,DFN,.217)
- +25 ;state abbrev
- WRITE " ",$$GET1^DIQ(5,+$$GET1^DIQ(2,DFN,.218,"I"),1)
- +26 SET X=$$GET1^DIQ(2,DFN,.219)
- IF X]""
- WRITE !?5,"Phone: ",X
- +27 ;
- +28 ; -- admission info
- +29 WRITE !!?5,"Admission Date: "
- +30 WRITE ?20,$$FMTE^XLFDT(+$$GET1^DIQ(405,BDGN,.01,"I"),"P")
- +31 IF $GET(^DPT(DFN,.105))=BDGN
- Begin DoDot:1
- +32 WRITE !?8,"Ward/Room-Bed: ",$GET(^DPT(DFN,.1))," / ",$GET(^DPT(DFN,.101))
- End DoDot:1
- +33 ;cmi/anch/maw 2/22/2007 add attending provider if there PATCH 1007 item 1007.42
- +34 WRITE !,?5,"Attending Provider: "
- +35 WRITE ?25,$$LASTPRV^BDGF1(BDGN,DFN)
- +36 ;cmi/anch/maw 2/22/2007 end of additions
- +37 ;
- +38 DO ^%ZISC
- KILL DFN,BDGN
- +39 DO KILL^AUPNPAT
- +40 QUIT
- +41 ;
