- AGNDX4 ; IHS/ASDS/EFG - PRINT ALL PATIENTS REGISTERED BY DAY(S) ;
- ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
- S AG("FD")="W !!,*7,""Do not use future dates.""" I '$D(DT) S %DT="",X="T" D ^%DT S DT=Y
- A2 W !!,"Enter the BEGINNING DATE for these cards: " D READ^AG Q:$D(DUOUT)!$D(DFOUT)!$D(DTOUT)!$D(DLOUT) S:$D(DQOUT) Y="?" S X=Y,%DT="XEP" D ^%DT G A2:Y<1 S AGBDATE=Y I Y>DT X AG("FD") G A2
- A3 W !!,"Enter the ENDING DATE for these cards: " D READ^AG Q:$D(DFOUT)!$D(DTOUT)!$D(DLOUT) G A2:$D(DUOUT) S:$D(DQOUT) Y="?" S:$D(DTIME) DTIME=300,X=Y,%DT="XEP" D ^%DT G A3:Y<1 S AGEDATE=Y I Y>DT X AG("FD") G A3
- I AGBDATE>AGEDATE W !!,*7,"INVALID ENTRY - The END is before the BEGINNING." G A2
- 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^AGNDX4",ZTUCI=Y,ZTDESC="Print Index Cards for Patients Registered from "_AGBDATE_" to "_AGEDATE_"." S:$D(AGALIAS) ZTSAVE("AGALIAS")="" F G="AGBDATE","AGEDATE" S ZTSAVE(G)=""
- D ^%ZTLOAD G:'$D(ZTSK) DEV K AG,AGALIAS,AGBDATE,AGEDATE,G,ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZTUCI D ^%ZISC
- Q
- START ;EP - From TaskMan.
- K ^TMP($J)
- F AGDT=AGBDATE-1:0 S AGDT=$O(^AUPNPAT("ADTE",AGDT)) Q:AGDT="" I ((AGDT'<AGBDATE)&(AGDT'>AGEDATE)) F IEN=0:0 S IEN=$O(^AUPNPAT("ADTE",AGDT,IEN)) Q:+IEN=0 S ^TMP($J,$P(^DPT(IEN,0),U),IEN)=""
- S AGNAME="" U IO
- F I=0:0 S AGNAME=$O(^TMP($J,AGNAME)) Q:AGNAME="" F IEN=0:0 S IEN=$O(^TMP($J,AGNAME,IEN)) Q:+IEN=0 S DFN=IEN D ^AGNDXP
- D ^%ZISC
- END K ^TMP($J),AG,AGALIAS,AGDT,AGBDATE,AGEDATE,I,IEN,IOP,AGNAME,X,Y D:$D(ZTQUEUED) KILL^%ZTLOAD
- Q
- AGNDX4 ; IHS/ASDS/EFG - PRINT ALL PATIENTS REGISTERED BY DAY(S) ;
- +1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
- +2 SET AG("FD")="W !!,*7,""Do not use future dates."""
- IF '$DATA(DT)
- SET %DT=""
- SET X="T"
- DO ^%DT
- SET DT=Y
- A2 WRITE !!,"Enter the BEGINNING DATE for these cards: "
- DO READ^AG
- IF $DATA(DUOUT)!$DATA(DFOUT)!$DATA(DTOUT)!$DATA(DLOUT)
- QUIT
- IF $DATA(DQOUT)
- SET Y="?"
- SET X=Y
- SET %DT="XEP"
- DO ^%DT
- IF Y<1
- GOTO A2
- SET AGBDATE=Y
- IF Y>DT
- XECUTE AG("FD")
- GOTO A2
- A3 WRITE !!,"Enter the ENDING DATE for these cards: "
- DO READ^AG
- IF $DATA(DFOUT)!$DATA(DTOUT)!$DATA(DLOUT)
- QUIT
- IF $DATA(DUOUT)
- GOTO A2
- IF $DATA(DQOUT)
- SET Y="?"
- IF $DATA(DTIME)
- SET DTIME=300
- SET X=Y
- SET %DT="XEP"
- DO ^%DT
- IF Y<1
- GOTO A3
- SET AGEDATE=Y
- IF Y>DT
- XECUTE AG("FD")
- GOTO A3
- +1 IF AGBDATE>AGEDATE
- WRITE !!,*7,"INVALID ENTRY - The END is before the BEGINNING."
- GOTO A2
- +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^AGNDX4"
- SET ZTUCI=Y
- SET ZTDESC="Print Index Cards for Patients Registered from "_AGBDATE_" to "_AGEDATE_"."
- IF $DATA(AGALIAS)
- SET ZTSAVE("AGALIAS")=""
- FOR G="AGBDATE","AGEDATE"
- SET ZTSAVE(G)=""
- +3 DO ^%ZTLOAD
- IF '$DATA(ZTSK)
- GOTO DEV
- KILL AG,AGALIAS,AGBDATE,AGEDATE,G,ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZTUCI
- DO ^%ZISC
- +4 QUIT
- START ;EP - From TaskMan.
- +1 KILL ^TMP($JOB)
- +2 FOR AGDT=AGBDATE-1:0
- SET AGDT=$ORDER(^AUPNPAT("ADTE",AGDT))
- IF AGDT=""
- QUIT
- IF ((AGDT'<AGBDATE)&(AGDT'>AGEDATE))
- FOR IEN=0:0
- SET IEN=$ORDER(^AUPNPAT("ADTE",AGDT,IEN))
- IF +IEN=0
- QUIT
- SET ^TMP($JOB,$PIECE(^DPT(IEN,0),U),IEN)=""
- +3 SET AGNAME=""
- USE IO
- +4 FOR I=0:0
- SET AGNAME=$ORDER(^TMP($JOB,AGNAME))
- IF AGNAME=""
- QUIT
- FOR IEN=0:0
- SET IEN=$ORDER(^TMP($JOB,AGNAME,IEN))
- IF +IEN=0
- QUIT
- SET DFN=IEN
- DO ^AGNDXP
- +5 DO ^%ZISC
- END KILL ^TMP($JOB),AG,AGALIAS,AGDT,AGBDATE,AGEDATE,I,IEN,IOP,AGNAME,X,Y
- IF $DATA(ZTQUEUED)
- DO KILL^%ZTLOAD
- +1 QUIT
