AGHOME.m

AGHOME ; IHS/ASDS/EFG - PRINT DIRECTIONS TO PATIENT'S HOME ;  

 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 D PTLK^AG

 Q:'$D(DFN)  I '$D(^AUPNPAT(DFN,12,1,0)) W !!,*7,"This patient has no entry in the ""DIRECTIONS"" file.",!,"Press RETURN..." R Y:DTIME Q

 S AGIO=IO

DEV S %ZIS="OPQ" D ^%ZIS I POP S IOP=ION D ^%ZIS Q

 G:'$D(IO("Q")) START K IO("Q") I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV

 X ^%ZOSF("UCI") S ZTRTN="START^AGHOME",ZTUCI=Y,ZTDESC="Directions to "_$P(^DPT(DFN,0),U)_"'s House." F G="DFN" S ZTSAVE(G)=""

 D ^%ZTLOAD G:'$D(ZTSK) DEV K AG,AGIO,G,ZTDESC,ZTRTN,ZTSK,ZTUCI D ^%ZISC

 Q

START ;EP - From TaskMan.

 U IO W $$S^AGVDF("IOF"),"Directions to patient's home.",!!,"PATIENT: ",$P(^DPT(DFN,0),U),!,"CHART #: ",$P(^AUPNPAT(DFN,41,DUZ(2),0),U,2),"   (",$P(^DIC(4,DUZ(2),0),U),")",!!

 W "DATE: " S Y=DT D DD^%DT W Y S AG("LINE")="=" D LINE^AG W !!!

 F AG=0:0 S AG=$O(^AUPNPAT(DFN,12,AG)) Q:'AG  W ^AUPNPAT(DFN,12,AG,0),!

END D RTRN^AG W $$S^AGVDF("IOF") D ^%ZISC

 K AG,AGIO,X,Y D:$D(ZTQUEUED) KILL^%ZTLOAD

 Q

AGHOME    ; IHS/ASDS/EFG - PRINT DIRECTIONS TO PATIENT'S HOME ;  

 +1       ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 +2        DO PTLK^AG

 +3        IF '$DATA(DFN)

               QUIT 

           IF '$DATA(^AUPNPAT(DFN,12,1,0))

               WRITE !!,*7,"This patient has no entry in the ""DIRECTIONS"" file.",!,"Press RETURN..."

               READ Y:DTIME

               QUIT 

 +4        SET AGIO=IO

DEV        SET %ZIS="OPQ"

           DO ^%ZIS

           IF POP

               SET IOP=ION

               DO ^%ZIS

               QUIT 

 +1        IF '$DATA(IO("Q"))

               GOTO START

           KILL IO("Q")

           IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")

               WRITE *7,!,"Please queue to system printers."

               DO ^%ZISC

               GOTO DEV

 +2        XECUTE ^%ZOSF("UCI")

           SET ZTRTN="START^AGHOME"

           SET ZTUCI=Y

           SET ZTDESC="Directions to "_$PIECE(^DPT(DFN,0),U)_"'s House."

           FOR G="DFN"

               SET ZTSAVE(G)=""

 +3        DO ^%ZTLOAD

           IF '$DATA(ZTSK)

               GOTO DEV

           KILL AG,AGIO,G,ZTDESC,ZTRTN,ZTSK,ZTUCI

           DO ^%ZISC

 +4        QUIT 

START     ;EP - From TaskMan.

 +1        USE IO

           WRITE $$S^AGVDF("IOF"),"Directions to patient's home.",!!,"PATIENT: ",$PIECE(^DPT(DFN,0),U),!,"CHART #: ",$PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,2),"   (",$PIECE(^DIC(4,DUZ(2),0),U),")",!!

 +2        WRITE "DATE: "

           SET Y=DT

           DO DD^%DT

           WRITE Y

           SET AG("LINE")="="

           DO LINE^AG

           WRITE !!!

 +3        FOR AG=0:0

               SET AG=$ORDER(^AUPNPAT(DFN,12,AG))

               IF 'AG

                   QUIT 

               WRITE ^AUPNPAT(DFN,12,AG,0),!

END        DO RTRN^AG

           WRITE $$S^AGVDF("IOF")

           DO ^%ZISC

 +1        KILL AG,AGIO,X,Y

           IF $DATA(ZTQUEUED)

               DO KILL^%ZTLOAD

 +2        QUIT