- AGCHLB ; IHS/ASDS/EFG - SELECT PATIENTS & PRINT CHART LABELS ;
- ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
- S AGTOT=0 K IOP,AG,DFN
- OPT G A:'$O(^AGCHLB(DUZ,0)) W !!,"Do you wish to re-print the previous list? (Y/N; ""S"" = see the list) " D READ^AG
- Q:$D(DFOUT)!$D(DUOUT)!$D(DTOUT)!$D(DLOUT) G OLD:Y?1"Y".E,NEW:Y?1"N",SEE:Y?1"S".E D YN^AG G OPT
- NEW K ^AGCHLB(DUZ) S ^AGCHLB(DUZ,0)="" G A ; Kill of un-subscripted work global.
- OLD S AGTOT=^AGCHLB(DUZ,"TOT") W !!,"Start with which patient? (RETURN = beginning) " D PTLK^AG G AGCHLB:$D(DUOUT)!$D(DFOUT)!$D(DTOUT),A1:'$D(DFN) I '$D(^AGCHLB(DUZ,DFN)) W !!,"This patient is not on the list - try again." G OPT
- S:DFN>0 AGDFN=DFN-1 G A1
- SEE W $$S^AGVDF("IOF"),"Previous list of chart labels.....",! S DFN=0
- F AG=1:1 S DFN=$O(^AGCHLB(DUZ,DFN)) G OPT:DFN="TOT" W:$D(^DPT(DFN)) !,$P(^DPT(DFN,0),U) I AG#20=0 W !!,"Press RETURN to continue; ""^"" to stop." D READ^AG W ! G AGCHLB:$D(DUOUT)
- A F AG=0:0 D PTLK^AG Q:'$D(DFN) S AGTOT=AGTOT+1,^AGCHLB(DUZ,DFN)="" W !,$P(^DPT(DFN,0),U)," is on the list."
- A1 G END:AGTOT=0 S ^AGCHLB(DUZ,"TOT")=AGTOT D:AGTOT>50 WAIT^DICD S DFN=0 F AG=1:1 S DFN=$O(^AGCHLB(DUZ,DFN)) G B:DFN="TOT" S ^AGCHLB(DUZ,DFN)=AG
- B S:$D(AGDFN) AGTOT=1+^AGCHLB(DUZ,"TOT")-^AGCHLB(DUZ,AGDFN+1) W !!!,"Number of names on the list: ",AGTOT,!!,"DO YOU WANT TO PRINT A TEST LABEL? (Y/N) Y// " D READ^AG S Y=$E(Y_"Y")
- I $D(DQOUT) W !!,"A sample label will be printed so that you",!,"may allign your labels on the printer." G B
- G END:$D(DTOUT)!$D(DFOUT)!$D(DUOUT),C:$D(DLOUT)!(Y="Y"),D:Y="N" D YN^AG G B
- C ;Print Test Label.
- D ^%ZIS Q:POP U IO F AG=1,2 W "IHSIHSIHSIHSIHSIHSIHSIHSIHSIHSIHS",!
- W !!!! D ^%ZISC
- G B
- D W !!,"How many copies of each label? (1 - 5) 1// " D READ^AG G B:$D(DTOUT)!$D(DFOUT)!$D(DUOUT) S:$D(DLOUT) Y=1 I $D(DQOUT)!(+Y>5)!(+Y<1) W !!,"You may make from 1 to 5 copies of each label.",!! G D
- S AGCOPY=+Y
- 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^AGCHLB",ZTUCI=Y,ZTDESC="Print Chart Lablels for "_$P(^AUTTLOC(DUZ(2),0),U,2)_"." S:'$D(AGDFN) AGDFN=0 F G="AGDFN","AGCOPY" S ZTSAVE(G)=""
- D ^%ZTLOAD G:'$D(ZTSK) DEV K AG,AGDFN,AGCOPY,G,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTUCI D ^%ZISC
- Q
- START ;EP - From TaskMan.
- S DFN=$S($D(AGDFN):AGDFN,1:0) U IO
- S1 S DFN=$O(^AGCHLB(DUZ,DFN)) G END:DFN="TOT"
- S (AGNAME,AGDOB,AGCHART)="",DA=DFN,DR=.01,DIC=2 D ^AGDICLK S:$D(AG("LKPRINT")) AGNAME=AG("LKPRINT") S AGCHART=$P(^AUPNPAT(DFN,41,DUZ(2),0),U,2),DR=.03 D ^AGDICLK S:$D(AG("LKPRINT")) AGDOB=AG("LKPRINT")
- S:$L(AGCHART)>3 AGCHART=$E(AGCHART,1,$L(AGCHART)-3)_"-"_$E(AGCHART,$L(AGCHART)-2,$L(AGCHART))
- F AG=1:1:AGCOPY W AGNAME,!,AGDOB,?27,$J(AGCHART,6),!!!!!
- G S1
- END D ^%ZISC K AG,AGCHART,AGDFN,AGDOB,AGNAME,DA,DFN,DIC,DR,AG("LKDATA"),AG("LKPRINT"),X,Y,Z D:$D(ZTQUEUED) KILL^%ZTLOAD
- Q
- AGCHLB ; IHS/ASDS/EFG - SELECT PATIENTS & PRINT CHART LABELS ;
- +1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
- +2 SET AGTOT=0
- KILL IOP,AG,DFN
- OPT IF '$ORDER(^AGCHLB(DUZ,0))
- GOTO A
- WRITE !!,"Do you wish to re-print the previous list? (Y/N; ""S"" = see the list) "
- DO READ^AG
- +1 IF $DATA(DFOUT)!$DATA(DUOUT)!$DATA(DTOUT)!$DATA(DLOUT)
- QUIT
- IF Y?1"Y".E
- GOTO OLD
- IF Y?1"N"
- GOTO NEW
- IF Y?1"S".E
- GOTO SEE
- DO YN^AG
- GOTO OPT
- NEW ; Kill of un-subscripted work global.
- KILL ^AGCHLB(DUZ)
- SET ^AGCHLB(DUZ,0)=""
- GOTO A
- OLD SET AGTOT=^AGCHLB(DUZ,"TOT")
- WRITE !!,"Start with which patient? (RETURN = beginning) "
- DO PTLK^AG
- IF $DATA(DUOUT)!$DATA(DFOUT)!$DATA(DTOUT)
- GOTO AGCHLB
- IF '$DATA(DFN)
- GOTO A1
- IF '$DATA(^AGCHLB(DUZ,DFN))
- WRITE !!,"This patient is not on the list - try again."
- GOTO OPT
- +1 IF DFN>0
- SET AGDFN=DFN-1
- GOTO A1
- SEE WRITE $$S^AGVDF("IOF"),"Previous list of chart labels.....",!
- SET DFN=0
- +1 FOR AG=1:1
- SET DFN=$ORDER(^AGCHLB(DUZ,DFN))
- IF DFN="TOT"
- GOTO OPT
- IF $DATA(^DPT(DFN))
- WRITE !,$PIECE(^DPT(DFN,0),U)
- IF AG#20=0
- WRITE !!,"Press RETURN to continue; ""^"" to stop."
- DO READ^AG
- WRITE !
- IF $DATA(DUOUT)
- GOTO AGCHLB
- A FOR AG=0:0
- DO PTLK^AG
- IF '$DATA(DFN)
- QUIT
- SET AGTOT=AGTOT+1
- SET ^AGCHLB(DUZ,DFN)=""
- WRITE !,$PIECE(^DPT(DFN,0),U)," is on the list."
- A1 IF AGTOT=0
- GOTO END
- SET ^AGCHLB(DUZ,"TOT")=AGTOT
- IF AGTOT>50
- DO WAIT^DICD
- SET DFN=0
- FOR AG=1:1
- SET DFN=$ORDER(^AGCHLB(DUZ,DFN))
- IF DFN="TOT"
- GOTO B
- SET ^AGCHLB(DUZ,DFN)=AG
- B IF $DATA(AGDFN)
- SET AGTOT=1+^AGCHLB(DUZ,"TOT")-^AGCHLB(DUZ,AGDFN+1)
- WRITE !!!,"Number of names on the list: ",AGTOT,!!,"DO YOU WANT TO PRINT A TEST LABEL? (Y/N) Y// "
- DO READ^AG
- SET Y=$EXTRACT(Y_"Y")
- +1 IF $DATA(DQOUT)
- WRITE !!,"A sample label will be printed so that you",!,"may allign your labels on the printer."
- GOTO B
- +2 IF $DATA(DTOUT)!$DATA(DFOUT)!$DATA(DUOUT)
- GOTO END
- IF $DATA(DLOUT)!(Y="Y")
- GOTO C
- IF Y="N"
- GOTO D
- DO YN^AG
- GOTO B
- C ;Print Test Label.
- +1 DO ^%ZIS
- IF POP
- QUIT
- USE IO
- FOR AG=1,2
- WRITE "IHSIHSIHSIHSIHSIHSIHSIHSIHSIHSIHS",!
- +2 WRITE !!!!
- DO ^%ZISC
- +3 GOTO B
- D WRITE !!,"How many copies of each label? (1 - 5) 1// "
- DO READ^AG
- IF $DATA(DTOUT)!$DATA(DFOUT)!$DATA(DUOUT)
- GOTO B
- IF $DATA(DLOUT)
- SET Y=1
- IF $DATA(DQOUT)!(+Y>5)!(+Y<1)
- WRITE !!,"You may make from 1 to 5 copies of each label.",!!
- GOTO D
- +1 SET AGCOPY=+Y
- 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^AGCHLB"
- SET ZTUCI=Y
- SET ZTDESC="Print Chart Lablels for "_$PIECE(^AUTTLOC(DUZ(2),0),U,2)_"."
- IF '$DATA(AGDFN)
- SET AGDFN=0
- FOR G="AGDFN","AGCOPY"
- SET ZTSAVE(G)=""
- +3 DO ^%ZTLOAD
- IF '$DATA(ZTSK)
- GOTO DEV
- KILL AG,AGDFN,AGCOPY,G,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTUCI
- DO ^%ZISC
- +4 QUIT
- START ;EP - From TaskMan.
- +1 SET DFN=$SELECT($DATA(AGDFN):AGDFN,1:0)
- USE IO
- S1 SET DFN=$ORDER(^AGCHLB(DUZ,DFN))
- IF DFN="TOT"
- GOTO END
- +1 SET (AGNAME,AGDOB,AGCHART)=""
- SET DA=DFN
- SET DR=.01
- SET DIC=2
- DO ^AGDICLK
- IF $DATA(AG("LKPRINT"))
- SET AGNAME=AG("LKPRINT")
- SET AGCHART=$PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,2)
- SET DR=.03
- DO ^AGDICLK
- IF $DATA(AG("LKPRINT"))
- SET AGDOB=AG("LKPRINT")
- +2 IF $LENGTH(AGCHART)>3
- SET AGCHART=$EXTRACT(AGCHART,1,$LENGTH(AGCHART)-3)_"-"_$EXTRACT(AGCHART,$LENGTH(AGCHART)-2,$LENGTH(AGCHART))
- +3 FOR AG=1:1:AGCOPY
- WRITE AGNAME,!,AGDOB,?27,$JUSTIFY(AGCHART,6),!!!!!
- +4 GOTO S1
- END DO ^%ZISC
- KILL AG,AGCHART,AGDFN,AGDOB,AGNAME,DA,DFN,DIC,DR,AG("LKDATA"),AG("LKPRINT"),X,Y,Z
- IF $DATA(ZTQUEUED)
- DO KILL^%ZTLOAD
- +1 QUIT
