AGNDX4.m

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