- DGRPD1 ;BPFO/JRC/BAJ - PATIENT INQUIRY (NEW) ; 8/15/08 11:35am
- ;;5.3;PIMS;**703,730,1015,1016**;JUN 30, 2012;Build 20
- ; DG*5.3*688 BAJ
- ; tags HDR & OKLINE moved as is from DGRPD for size considerations
- Q
- EC ;display emergency contact information
- N DGEC1,DGEC2
- Q:'$G(DFN)
- S VAOA("A")=1,VAROOT="DGEC1" D OAD^VADPT ; Get Primary EC
- S VAOA("A")=4,VAROOT="DGEC2" D OAD^VADPT ; Get Secondary EC
- I DGEC1(9)]"" D
- . W !,"Emergency Contact Information:"
- . ;Contacts name and realtionship
- . W !?5,"E-Cont.: ",DGEC1(9)
- . I DGEC2(9)]"" W ?40,"E2-Cont.: ",DGEC2(9)
- . W !,"Relationship: ",DGEC1(10)
- . I DGEC2(9)]"" W ?36,"Relationship: ",DGEC2(10)
- . ;ECs address lines 1, 2 and 3
- . I DGEC1(1)]"" W !?14,DGEC1(1)
- . I DGEC1(1)']"",DGEC2(1)]"" W !
- . I DGEC2(1)]"" W ?50,DGEC2(1)
- . I DGEC1(2)]"" W !?14,DGEC1(2)
- . I DGEC1(2)']"",DGEC2(2)]"" W !
- . I DGEC2(2)]"" W ?50,DGEC2(2)
- . I DGEC1(3)]"" W !?14,DGEC1(3)
- . I DGEC1(3)']"",DGEC2(3)]"" W !
- . I DGEC2(3)]"" W ?50,DGEC2(3)
- . ;Emergency Contact 1 City, State an Zip+4
- . I DGEC1(4)]"" D
- . . W !?14,DGEC1(4)
- . . I DGEC1(5)]"" W ", "_$$GET1^DIQ(5,+DGEC1(5),1)
- . . W " ",$P(DGEC1(11),"^",2)
- . ;Emergency Contact 2 City State and Zip+4
- . I DGEC2(4)]"" D
- . . I DGEC1(4)']"" W !
- . . W ?50,DGEC2(4)
- . . I DGEC2(5)]"" W ", "_$$GET1^DIQ(5,+DGEC2(5),1)
- . . W " ",$P(DGEC2(11),"^",2)
- .;Home and work phones
- . W !,?7,"Phone: ",$S(DGEC1(8)]"":DGEC1(8),1:"UNSPECIFIED")
- . I DGEC2(9)]"" W ?43,"Phone: ",$S(DGEC2(8)]"":DGEC2(8),1:"UNSPECIFIED")
- . W !?2,"Work Phone: ",$S($P(^DPT(DFN,.33),U,11)]"":$P(^DPT(DFN,.33),U,11),1:"UNSPECIFIED")
- . I DGEC2(9)]"" W ?38,"Work Phone: ",$S($P(^DPT(DFN,.331),U,11)]"":$P(^DPT(DFN,.331),U,11),1:"UNSPECIFIED")
- D KVAR^VADPT
- Q
- ;
- CATDIS ;
- ;displays catastrophic disabity review date if there is one
- N DGCDIS
- Q:'$G(DFN)
- I $$GET^DGENCDA(DFN,.DGCDIS) D
- .Q:'DGCDIS("REVDTE")
- .W !!,"Catastrophically Disabled Review Date: ",$$FMTE^XLFDT(DGCDIS("REVDTE"),1)
- Q
- HDR I '$D(IOF) S IOP="HOME" D ^%ZIS K IOP
- ;MPI/PD CHANGE
- W @IOF,!,$P(VADM(1),"^",1),?40,$P(VADM(2),"^",2),?65,$P(VADM(3),"^",2) S X="",$P(X,"=",78)="" W !,X,!?15,"COORDINATING MASTER OF RECORD: ",DGCMOR,! Q
- ;END MPI/PD CHANGE
- OKLINE(DGLINE) ;DOES PAUSE/HEADER IF $Y EXCEEDS DGLINE
- ;
- ;IN: DGLINE --MAX LINE COUNT W/O PAUSE
- ;OUT: DGLINE[RETURNED] -- 0 IF TIMEOUT/UP ARROW
- ; DGRPOUT[SET] -- 1 IF "
- N X,Y ;**286** MLR 09/25/00 Newing X & Y variables prior to ^DIR
- I $G(IOST)["P-" Q DGLINE ; if printer, quit
- I $Y>DGLINE N DIR S DIR(0)="E" D ^DIR D:Y HDR I 'Y S DGRPOUT=1,DGLINE=0
- Q DGLINE
- ;
- DGRPD1 ;BPFO/JRC/BAJ - PATIENT INQUIRY (NEW) ; 8/15/08 11:35am
- +1 ;;5.3;PIMS;**703,730,1015,1016**;JUN 30, 2012;Build 20
- +2 ; DG*5.3*688 BAJ
- +3 ; tags HDR & OKLINE moved as is from DGRPD for size considerations
- +4 QUIT
- EC ;display emergency contact information
- +1 NEW DGEC1,DGEC2
- +2 IF '$GET(DFN)
- QUIT
- +3 ; Get Primary EC
- SET VAOA("A")=1
- SET VAROOT="DGEC1"
- DO OAD^VADPT
- +4 ; Get Secondary EC
- SET VAOA("A")=4
- SET VAROOT="DGEC2"
- DO OAD^VADPT
- +5 IF DGEC1(9)]""
- Begin DoDot:1
- +6 WRITE !,"Emergency Contact Information:"
- +7 ;Contacts name and realtionship
- +8 WRITE !?5,"E-Cont.: ",DGEC1(9)
- +9 IF DGEC2(9)]""
- WRITE ?40,"E2-Cont.: ",DGEC2(9)
- +10 WRITE !,"Relationship: ",DGEC1(10)
- +11 IF DGEC2(9)]""
- WRITE ?36,"Relationship: ",DGEC2(10)
- +12 ;ECs address lines 1, 2 and 3
- +13 IF DGEC1(1)]""
- WRITE !?14,DGEC1(1)
- +14 IF DGEC1(1)']""
- IF DGEC2(1)]""
- WRITE !
- +15 IF DGEC2(1)]""
- WRITE ?50,DGEC2(1)
- +16 IF DGEC1(2)]""
- WRITE !?14,DGEC1(2)
- +17 IF DGEC1(2)']""
- IF DGEC2(2)]""
- WRITE !
- +18 IF DGEC2(2)]""
- WRITE ?50,DGEC2(2)
- +19 IF DGEC1(3)]""
- WRITE !?14,DGEC1(3)
- +20 IF DGEC1(3)']""
- IF DGEC2(3)]""
- WRITE !
- +21 IF DGEC2(3)]""
- WRITE ?50,DGEC2(3)
- +22 ;Emergency Contact 1 City, State an Zip+4
- +23 IF DGEC1(4)]""
- Begin DoDot:2
- +24 WRITE !?14,DGEC1(4)
- +25 IF DGEC1(5)]""
- WRITE ", "_$$GET1^DIQ(5,+DGEC1(5),1)
- +26 WRITE " ",$PIECE(DGEC1(11),"^",2)
- End DoDot:2
- +27 ;Emergency Contact 2 City State and Zip+4
- +28 IF DGEC2(4)]""
- Begin DoDot:2
- +29 IF DGEC1(4)']""
- WRITE !
- +30 WRITE ?50,DGEC2(4)
- +31 IF DGEC2(5)]""
- WRITE ", "_$$GET1^DIQ(5,+DGEC2(5),1)
- +32 WRITE " ",$PIECE(DGEC2(11),"^",2)
- End DoDot:2
- +33 ;Home and work phones
- +34 WRITE !,?7,"Phone: ",$SELECT(DGEC1(8)]"":DGEC1(8),1:"UNSPECIFIED")
- +35 IF DGEC2(9)]""
- WRITE ?43,"Phone: ",$SELECT(DGEC2(8)]"":DGEC2(8),1:"UNSPECIFIED")
- +36 WRITE !?2,"Work Phone: ",$SELECT($PIECE(^DPT(DFN,.33),U,11)]"":$PIECE(^DPT(DFN,.33),U,11),1:"UNSPECIFIED")
- +37 IF DGEC2(9)]""
- WRITE ?38,"Work Phone: ",$SELECT($PIECE(^DPT(DFN,.331),U,11)]"":$PIECE(^DPT(DFN,.331),U,11),1:"UNSPECIFIED")
- End DoDot:1
- +38 DO KVAR^VADPT
- +39 QUIT
- +40 ;
- CATDIS ;
- +1 ;displays catastrophic disabity review date if there is one
- +2 NEW DGCDIS
- +3 IF '$GET(DFN)
- QUIT
- +4 IF $$GET^DGENCDA(DFN,.DGCDIS)
- Begin DoDot:1
- +5 IF 'DGCDIS("REVDTE")
- QUIT
- +6 WRITE !!,"Catastrophically Disabled Review Date: ",$$FMTE^XLFDT(DGCDIS("REVDTE"),1)
- End DoDot:1
- +7 QUIT
- HDR IF '$DATA(IOF)
- SET IOP="HOME"
- DO ^%ZIS
- KILL IOP
- +1 ;MPI/PD CHANGE
- +2 WRITE @IOF,!,$PIECE(VADM(1),"^",1),?40,$PIECE(VADM(2),"^",2),?65,$PIECE(VADM(3),"^",2)
- SET X=""
- SET $PIECE(X,"=",78)=""
- WRITE !,X,!?15,"COORDINATING MASTER OF RECORD: ",DGCMOR,!
- QUIT
- +3 ;END MPI/PD CHANGE
- OKLINE(DGLINE) ;DOES PAUSE/HEADER IF $Y EXCEEDS DGLINE
- +1 ;
- +2 ;IN: DGLINE --MAX LINE COUNT W/O PAUSE
- +3 ;OUT: DGLINE[RETURNED] -- 0 IF TIMEOUT/UP ARROW
- +4 ; DGRPOUT[SET] -- 1 IF "
- +5 ;**286** MLR 09/25/00 Newing X & Y variables prior to ^DIR
- NEW X,Y
- +6 ; if printer, quit
- IF $GET(IOST)["P-"
- QUIT DGLINE
- +7 IF $Y>DGLINE
- NEW DIR
- SET DIR(0)="E"
- DO ^DIR
- IF Y
- DO HDR
- IF 'Y
- SET DGRPOUT=1
- SET DGLINE=0
- +8 QUIT DGLINE
- +9 ;
