- AGNDX3 ; IHS/ASDS/EFG - PRINT RANGE OF PATIENTS BY NAME ;
- ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
- W !!,"YOU MAY SELECT A RANGE OF NAMES FOR WHICH YOU WOULD LIKE TO PRINT INDEX CARDS. SIMPLY ENTER THE BEGINNING AND ENDING NAMES AS THEY ARE REQUESTED."
- CC W !!,"START WITH WHAT PATIENT NAME? " D PTLK^AG
- G:'$D(DFN) END S AGBEG=$P(^DPT(DFN,0),U)
- D W !!,"END WITH WHAT PATIENT NAME? " D PTLK^AG
- G:'$D(DFN) END S AGEND=$P(^DPT(DFN,0),U) I AGBEG]AGEND W !!,*7,"THE ENDING NAME PRECEDES THE BEGINNING NAME." G CC
- D ALIAS^AGNDXP
- G END:$D(DTOUT)!$D(DFOUT)!$D(DUOUT)
- 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^AGNDX3",ZTUCI=Y,ZTDESC="Index Cards from "_AGBEG_" to "_AGEND_"." S:$D(AGALIAS) ZTSAVE("AGALIAS")="" F G="AGBEG","AGEND" S ZTSAVE(G)=""
- D ^%ZTLOAD G:'$D(ZTSK) DEV K AG,AGALIAS,AGBEG,AGEND,G,ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZTUCI D ^%ZISC
- Q
- START ;EP - From TaskMan.
- U IO F AGCTR3=0:1 S:AGCTR3>0 AGBEG=$O(^DPT("B",AGBEG)) Q:AGBEG=""!(AGBEG]AGEND) F IEN=0:0 S IEN=$O(^DPT("B",AGBEG,IEN)) Q:IEN="" I $D(^(IEN))=1 S DFN=IEN D ^AGNDXP
- D ^%ZISC
- END K AG,AGALIAS,AGBEG,AGEND,AGCTR3,IEN,X,Y D:$D(ZTQUEUED) KILL^%ZTLOAD
- Q
- AGNDX3 ; IHS/ASDS/EFG - PRINT RANGE OF PATIENTS BY NAME ;
- +1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
- +2 WRITE !!,"YOU MAY SELECT A RANGE OF NAMES FOR WHICH YOU WOULD LIKE TO PRINT INDEX CARDS. SIMPLY ENTER THE BEGINNING AND ENDING NAMES AS THEY ARE REQUESTED."
- CC WRITE !!,"START WITH WHAT PATIENT NAME? "
- DO PTLK^AG
- +1 IF '$DATA(DFN)
- GOTO END
- SET AGBEG=$PIECE(^DPT(DFN,0),U)
- D WRITE !!,"END WITH WHAT PATIENT NAME? "
- DO PTLK^AG
- +1 IF '$DATA(DFN)
- GOTO END
- SET AGEND=$PIECE(^DPT(DFN,0),U)
- IF AGBEG]AGEND
- WRITE !!,*7,"THE ENDING NAME PRECEDES THE BEGINNING NAME."
- GOTO CC
- +2 DO ALIAS^AGNDXP
- +3 IF $DATA(DTOUT)!$DATA(DFOUT)!$DATA(DUOUT)
- GOTO END
- 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^AGNDX3"
- SET ZTUCI=Y
- SET ZTDESC="Index Cards from "_AGBEG_" to "_AGEND_"."
- IF $DATA(AGALIAS)
- SET ZTSAVE("AGALIAS")=""
- FOR G="AGBEG","AGEND"
- SET ZTSAVE(G)=""
- +3 DO ^%ZTLOAD
- IF '$DATA(ZTSK)
- GOTO DEV
- KILL AG,AGALIAS,AGBEG,AGEND,G,ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZTUCI
- DO ^%ZISC
- +4 QUIT
- START ;EP - From TaskMan.
- +1 USE IO
- FOR AGCTR3=0:1
- IF AGCTR3>0
- SET AGBEG=$ORDER(^DPT("B",AGBEG))
- IF AGBEG=""!(AGBEG]AGEND)
- QUIT
- FOR IEN=0:0
- SET IEN=$ORDER(^DPT("B",AGBEG,IEN))
- IF IEN=""
- QUIT
- IF $DATA(^(IEN))=1
- SET DFN=IEN
- DO ^AGNDXP
- +2 DO ^%ZISC
- END KILL AG,AGALIAS,AGBEG,AGEND,AGCTR3,IEN,X,Y
- IF $DATA(ZTQUEUED)
- DO KILL^%ZTLOAD
- +1 QUIT
