- AGADDINF ; IHS/ASDS/EFG - PRINT ADDITIONAL REG. INFORMATION ;
- ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
- D PTLK^AG
- Q:'$D(DFN) I '$D(^AUPNPAT(DFN,13,1,0)) W !!,*7,"This patient has no entry in the ""ADDITIONAL INFO."" file.",!,"Press RETURN..." R Y:DTIME Q
- DEV S AGIO=IO,%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^AGADDINF",ZTUCI=Y,ZTDESC="Additional Reg Info for "_$P(^DPT(DFN,0),U)_"." F G="DFN" S ZTSAVE(G)=""
- D ^%ZTLOAD G:'$D(ZTSK) DEV K AG,AGIO,DFN,ZTDESC,ZTRTN,ZTSK,ZTUCI D ^%ZISC
- Q
- START ;EP - From TaskMan.
- D LINES^AG U IO W $$S^AGVDF("IOF"),"Additional registration information....",!!,"PATIENT: ",$P(^DPT(DFN,0),U),!,"CHART #: ",$P(^AUPNPAT(DFN,41,DUZ(2),0),U,2)," (",$P(^DIC(4,DUZ(2),0),U),")",!!,"DATE: " S Y=DT D DD^%DT W Y,!,AG("="),!!!!
- F AG=0:0 S AG=$O(^AUPNPAT(DFN,13,AG)) Q:'AG W ^AUPNPAT(DFN,13,AG,0),!
- D RTRN^AG W $$S^AGVDF("IOF") D ^%ZISC K AG,AGIO,DFN D:$D(ZTQUEUED) KILL^%ZTLOAD
- Q
- AGADDINF ; IHS/ASDS/EFG - PRINT ADDITIONAL REG. INFORMATION ;
- +1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
- +2 DO PTLK^AG
- +3 IF '$DATA(DFN)
- QUIT
- IF '$DATA(^AUPNPAT(DFN,13,1,0))
- WRITE !!,*7,"This patient has no entry in the ""ADDITIONAL INFO."" file.",!,"Press RETURN..."
- READ Y:DTIME
- QUIT
- DEV SET AGIO=IO
- SET %ZIS="OPQ"
- DO ^%ZIS
- IF POP
- SET IOP=ION
- DO ^%ZIS
- QUIT
- +1 IF '$DATA(IO("Q"))
- GOTO START
- KILL IO("Q")
- +2 IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")
- WRITE *7,!,"Please queue to system printers."
- DO ^%ZISC
- GOTO DEV
- +3 XECUTE ^%ZOSF("UCI")
- SET ZTRTN="START^AGADDINF"
- SET ZTUCI=Y
- SET ZTDESC="Additional Reg Info for "_$PIECE(^DPT(DFN,0),U)_"."
- FOR G="DFN"
- SET ZTSAVE(G)=""
- +4 DO ^%ZTLOAD
- IF '$DATA(ZTSK)
- GOTO DEV
- KILL AG,AGIO,DFN,ZTDESC,ZTRTN,ZTSK,ZTUCI
- DO ^%ZISC
- +5 QUIT
- START ;EP - From TaskMan.
- +1 DO LINES^AG
- USE IO
- WRITE $$S^AGVDF("IOF"),"Additional registration information....",!!,"PATIENT: ",$PIECE(^DPT(DFN,0),U),!,"CHART #: ",$PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,2)," (",$PIECE(^DIC(4,DUZ(2),0),U),")",!!,"DATE: "
- SET Y=DT
- DO DD^%DT
- WRITE Y,!,AG("="),!!!!
- +2 FOR AG=0:0
- SET AG=$ORDER(^AUPNPAT(DFN,13,AG))
- IF 'AG
- QUIT
- WRITE ^AUPNPAT(DFN,13,AG,0),!
- +3 DO RTRN^AG
- WRITE $$S^AGVDF("IOF")
- DO ^%ZISC
- KILL AG,AGIO,DFN
- IF $DATA(ZTQUEUED)
- DO KILL^%ZTLOAD
- +4 QUIT
