AGADDR1.m

AGADDR1 ; IHS/ASDS/EFG - REGISTRATION MAILING LIST PRINT/EDIT (2 OF 2) ;  

 ;;7.1;PATIENT REGISTRATION;**4**;AUG 25,2005

NEWLST ;EP

 I '$D(^AGADLIST(AGLIST,1,0)) S ^(0)="^9009065.05P^"

 S AGV("P3")=+$P(^AGADLIST(AGLIST,1,0),U,3),AGV("P4")=+$P(^(0),U,4)

 W !,"Date Generated : " S Y=$P(^AGADLIST(AGLIST,0),U,2) D DD^%DT W Y,"  Last Updated : " S Y=$P(^AGADLIST(AGLIST,0),U,3) D DD^%DT W Y,"  # Names = ",AGV("P4"),!

 Q:AGV("P4")<1  W ?5,"Do you want to see a list of these names (Y/N) N// " D READ^AG

 Q:$D(DFOUT)!$D(DUOUT)!$D(DTOUT)!$D(DLOUT)!(Y?1"N".E)

NEWLST1 ;Display List of Patients on Screen.

 S R="",AGV("RR")=0,AGV("RX")="" W !!

NEWLST2 S R=$O(^AGADLIST(AGLIST,1,"C",R)) G NEWLSTX:R=""

NEWLST3 S AGV("RX")=$O(^AGADLIST(AGLIST,1,"C",R,AGV("RX"))) G NEWLST2:+AGV("RX")=0

 S AGV("RR")=AGV("RR")+1,AGV("ZR")=$P(^AGADLIST(AGLIST,1,AGV("RX"),0),U)

 I AGV("RR")#2=0 W ?40,$P(^DPT(AGV("ZR"),0),U),! G NEWLST4

 W $P(^DPT(AGV("ZR"),0),U)

NEWLST4 I AGV("RR")#40=0 W !,"Enter ""^"" to Stop List <RETURN> to Continue  " D READ^AG W ! I $D(DUOUT) G NEWLSTX

 G NEWLST3

NEWLSTX Q

VAROLD ;EP

 W !!,"Start with which patient? (RETURN = beginning) " K DIC S DIC("W")="D ^AGSCANP" D SET^AUPNLKZ,PTLK^AG,RESET^AUPNLKZ

 G ^AGADDR:$D(DUOUT),B:'$D(DFN) I '$D(^AGADLIST(AGLIST,1,"B",DFN)) W !!,"This patient is not on the list - try again." G VAROLD

A S AG("START")=$P(^DPT(DFN,0),U)

B W !!,"DO YOU WANT TO PRINT A TEST LABEL?  (Y/N) //Y " D READ^AG

 G ^AGADDR:$D(DTOUT)!$D(DFOUT)!$D(DUOUT),C:$D(DLOUT),QUES:$D(DQOUT),C:Y?1"Y".E,D:Y?1"N".E D YN^AG G B

C D ^%ZIS Q:POP  U IO F I=1:1:3 W AGV("LINE"),!

 W !!! D ^%ZISC

 G B

D W !!,"How many copies of each label? (1 - 5) 1// " D READ^AG S:$D(DLOUT) Y=1 G B:$D(DTOUT)!$D(DFOUT)!$D(DUOUT) I $D(DQOUT)!(+Y>5)!(+Y<1) W !!,"You may make from 1 to 5 copies of each label.",!! G D

 S AG("#")=+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^AGADDR1",ZTUCI=Y,ZTDESC="Print Mailing List for "_$P(^AUTTLOC(DUZ(2),0),U,2)_"." S:$D(AG("START")) ZTSAVE("AG(""START"")")="" F G="AG(""#"")","AGLIST" S ZTSAVE(G)=""

 D ^%ZTLOAD G:'$D(ZTSK) DEV K AG,G,ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZTUCI D ^%ZISC

 Q

START ;EP - From TaskMan.

 S AGV("RR")=0,AGV("STX")="" I $D(AG("START")) S AGV("STX")=AG("START"),AGV("LC")=$E(AGV("STX"),$L(AGV("STX")),$L(AGV("STX"))),AGV("STX")=$E(AGV("STX"),1,$L(AGV("STX"))-1)_$C($A(AGV("LC"))-1)

E U IO S AGV("STX")=$O(^AGADLIST(AGLIST,1,"C",AGV("STX"))) G END^AGADDR:AGV("STX")=""

E0 S AGV("RR")=$O(^AGADLIST(AGLIST,1,"C",AGV("STX"),AGV("RR"))) G E:AGV("RR")=""

 S DFN=$P(^AGADLIST(AGLIST,1,AGV("RR"),0),U)

 I '$D(^DPT(DFN,0)) G E0

 ;S (AGNAME,AGADRS1,AGADRS2)="",DA=DFN,DR=.01,DIC=2 D ^AGDICLK I $D(AG("LKPRINT")) S AGNAME=$P(AG("LKPRINT"),",",2)_" "_$P(AG("LKPRINT"),",",1)

 S (AGNAME,AGADRS1,AGADRS2)="",DA=DFN,DR=.01,DIC=2 D ^AGDICLK I $D(AG("LKPRINT")) S AGNAME=$P(AG("LKPRINT"),",",2)_" "_$P(AG("LKPRINT"),",",1)_" "_$P(AG("LKPRINT"),",",3)  ;AG*7.1*4

 S DR=.111 D ^AGDICLK I $D(AG("LKPRINT")) S AGADRS1=AG("LKPRINT")

 S DR=.114 D ^AGDICLK I $D(AG("LKPRINT")) S AGADRS2=AG("LKPRINT")

 S DR=.115 D ^AGDICLK I $D(AG("LKDATA")),AG("LKDATA")]"" S AGADRS2=AGADRS2_" "_$P(^DIC(5,AG("LKDATA"),0),U,2)

 S DR=.116 D ^AGDICLK I $D(AG("LKPRINT")) S AGADRS2=AGADRS2_"  "_AG("LKPRINT")

 F AG("I")=1:1:AG("#") W AGNAME,!,AGADRS1,!,AGADRS2,!!!!

 G E0

QUES W !!,"A sample label will be printed so that you",!,"may allign your labels on the printer." G B

AGADDR1   ; IHS/ASDS/EFG - REGISTRATION MAILING LIST PRINT/EDIT (2 OF 2) ;  

 +1       ;;7.1;PATIENT REGISTRATION;**4**;AUG 25,2005

NEWLST    ;EP

 +1        IF '$DATA(^AGADLIST(AGLIST,1,0))

               SET ^(0)="^9009065.05P^"

 +2        SET AGV("P3")=+$PIECE(^AGADLIST(AGLIST,1,0),U,3)

           SET AGV("P4")=+$PIECE(^(0),U,4)

 +3        WRITE !,"Date Generated : "

           SET Y=$PIECE(^AGADLIST(AGLIST,0),U,2)

           DO DD^%DT

           WRITE Y,"  Last Updated : "

           SET Y=$PIECE(^AGADLIST(AGLIST,0),U,3)

           DO DD^%DT

           WRITE Y,"  # Names = ",AGV("P4"),!

 +4        IF AGV("P4")<1

               QUIT 

           WRITE ?5,"Do you want to see a list of these names (Y/N) N// "

           DO READ^AG

 +5        IF $DATA(DFOUT)!$DATA(DUOUT)!$DATA(DTOUT)!$DATA(DLOUT)!(Y?1"N".E)

               QUIT 

NEWLST1   ;Display List of Patients on Screen.

 +1        SET R=""

           SET AGV("RR")=0

           SET AGV("RX")=""

           WRITE !!

NEWLST2    SET R=$ORDER(^AGADLIST(AGLIST,1,"C",R))

           IF R=""

               GOTO NEWLSTX

NEWLST3    SET AGV("RX")=$ORDER(^AGADLIST(AGLIST,1,"C",R,AGV("RX")))

           IF +AGV("RX")=0

               GOTO NEWLST2

 +1        SET AGV("RR")=AGV("RR")+1

           SET AGV("ZR")=$PIECE(^AGADLIST(AGLIST,1,AGV("RX"),0),U)

 +2        IF AGV("RR")#2=0

               WRITE ?40,$PIECE(^DPT(AGV("ZR"),0),U),!

               GOTO NEWLST4

 +3        WRITE $PIECE(^DPT(AGV("ZR"),0),U)

NEWLST4    IF AGV("RR")#40=0

               WRITE !,"Enter ""^"" to Stop List <RETURN> to Continue  "

               DO READ^AG

               WRITE !

               IF $DATA(DUOUT)

                   GOTO NEWLSTX

 +1        GOTO NEWLST3

NEWLSTX    QUIT 

VAROLD    ;EP

 +1        WRITE !!,"Start with which patient? (RETURN = beginning) "

           KILL DIC

           SET DIC("W")="D ^AGSCANP"

           DO SET^AUPNLKZ

           DO PTLK^AG

           DO RESET^AUPNLKZ

 +2        IF $DATA(DUOUT)

               GOTO ^AGADDR

           IF '$DATA(DFN)

               GOTO B

           IF '$DATA(^AGADLIST(AGLIST,1,"B",DFN))

               WRITE !!,"This patient is not on the list - try again."

               GOTO VAROLD

A          SET AG("START")=$PIECE(^DPT(DFN,0),U)

B          WRITE !!,"DO YOU WANT TO PRINT A TEST LABEL?  (Y/N) //Y "

           DO READ^AG

 +1        IF $DATA(DTOUT)!$DATA(DFOUT)!$DATA(DUOUT)

               GOTO ^AGADDR

           IF $DATA(DLOUT)

               GOTO C

           IF $DATA(DQOUT)

               GOTO QUES

           IF Y?1"Y".E

               GOTO C

           IF Y?1"N".E

               GOTO D

           DO YN^AG

           GOTO B

C          DO ^%ZIS

           IF POP

               QUIT 

           USE IO

           FOR I=1:1:3

               WRITE AGV("LINE"),!

 +1        WRITE !!!

           DO ^%ZISC

 +2        GOTO B

D          WRITE !!,"How many copies of each label? (1 - 5) 1// "

           DO READ^AG

           IF $DATA(DLOUT)

               SET Y=1

           IF $DATA(DTOUT)!$DATA(DFOUT)!$DATA(DUOUT)

               GOTO B

           IF $DATA(DQOUT)!(+Y>5)!(+Y<1)

               WRITE !!,"You may make from 1 to 5 copies of each label.",!!

               GOTO D

 +1        SET AG("#")=+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")

 +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^AGADDR1"

           SET ZTUCI=Y

           SET ZTDESC="Print Mailing List for "_$PIECE(^AUTTLOC(DUZ(2),0),U,2)_"."

           IF $DATA(AG("START"))

               SET ZTSAVE("AG(""START"")")=""

           FOR G="AG(""#"")","AGLIST"

               SET ZTSAVE(G)=""

 +4        DO ^%ZTLOAD

           IF '$DATA(ZTSK)

               GOTO DEV

           KILL AG,G,ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZTUCI

           DO ^%ZISC

 +5        QUIT 

START     ;EP - From TaskMan.

 +1        SET AGV("RR")=0

           SET AGV("STX")=""

           IF $DATA(AG("START"))

               SET AGV("STX")=AG("START")

               SET AGV("LC")=$EXTRACT(AGV("STX"),$LENGTH(AGV("STX")),$LENGTH(AGV("STX")))

               SET AGV("STX")=$EXTRACT(AGV("STX"),1,$LENGTH(AGV("STX"))-1)_$CHAR($ASCII(AGV("LC"))-1)

E          USE IO

           SET AGV("STX")=$ORDER(^AGADLIST(AGLIST,1,"C",AGV("STX")))

           IF AGV("STX")=""

               GOTO END^AGADDR

E0         SET AGV("RR")=$ORDER(^AGADLIST(AGLIST,1,"C",AGV("STX"),AGV("RR")))

           IF AGV("RR")=""

               GOTO E

 +1        SET DFN=$PIECE(^AGADLIST(AGLIST,1,AGV("RR"),0),U)

 +2        IF '$DATA(^DPT(DFN,0))

               GOTO E0

 +3       ;S (AGNAME,AGADRS1,AGADRS2)="",DA=DFN,DR=.01,DIC=2 D ^AGDICLK I $D(AG("LKPRINT")) S AGNAME=$P(AG("LKPRINT"),",",2)_" "_$P(AG("LKPRINT"),",",1)

 +4       ;AG*7.1*4

           SET (AGNAME,AGADRS1,AGADRS2)=""

           SET DA=DFN

           SET DR=.01

           SET DIC=2

           DO ^AGDICLK

           IF $DATA(AG("LKPRINT"))

               SET AGNAME=$PIECE(AG("LKPRINT"),",",2)_" "_$PIECE(AG("LKPRINT"),",",1)_" "_$PIECE(AG("LKPRINT"),",",3)

 +5        SET DR=.111

           DO ^AGDICLK

           IF $DATA(AG("LKPRINT"))

               SET AGADRS1=AG("LKPRINT")

 +6        SET DR=.114

           DO ^AGDICLK

           IF $DATA(AG("LKPRINT"))

               SET AGADRS2=AG("LKPRINT")

 +7        SET DR=.115

           DO ^AGDICLK

           IF $DATA(AG("LKDATA"))

               IF AG("LKDATA")]""

                   SET AGADRS2=AGADRS2_" "_$PIECE(^DIC(5,AG("LKDATA"),0),U,2)

 +8        SET DR=.116

           DO ^AGDICLK

           IF $DATA(AG("LKPRINT"))

               SET AGADRS2=AGADRS2_"  "_AG("LKPRINT")

 +9        FOR AG("I")=1:1:AG("#")

               WRITE AGNAME,!,AGADRS1,!,AGADRS2,!!!!

 +10       GOTO E0

QUES       WRITE !!,"A sample label will be printed so that you",!,"may allign your labels on the printer."

           GOTO B