ABPAAGEL ;PRINT MAILING LABELS FOR OUTSTANDING BILLS; [ 07/25/91 11:10 AM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
W !!,"<<< SORRY, ACCESS DENIED!!! >>>",!! G ZTLEND
;--------------------------------------------------------------------
HEAD ;PROCEDURE TO DRAW SCREEN HEADING
K ABPA("HD") S ABPA("HD",1)=ABPATLE
S ABPA("HD",2)="Print MAILING LABELS for outstanding bills" D ^ABPAHD
Q
;--------------------------------------------------------------------
TASK K DIR S DIR(0)="NO",DIR("A")="Select REPORT TASK NUMBER" W !! D ^DIR
K ZTSK I Y S ZTSK=+Y
E D Q
.K ABPAMESS S ABPAMESS="NO TASK SELECTED - JOB ABORTED"
.S ABPAMESS(2)="... Press any key to continue ..." D PAUSE^ABPAMAIN
I $D(^%ZTSK(ZTSK,0))'=11 W *7,!?5,"<<< TASK NOT FOUND >>>" G TASK
S ZTRTN=$P(^%ZTSK(ZTSK,0),"^",1,2) I ZTRTN'="MAIN^ABPAAGE2" D G TASK
.W *7,!?5,"<<< INVALID TASK NUMBER >>>"
I $D(^%ZTSK(ZTSK,0,"ZTN"))'=1 D G TASK
.W *7,!?5,"<<< MISSING NODE FROM THE TASK FILE >>>"
S ZTSK=+^%ZTSK(ZTSK,0,"ZTN") I $D(^%ZTSK(ZTSK,"INSURER"))'=10 D G TASK
.W *7,!?5,"<<< MISSING NODE FROM THE TASK FILE >>>"
Q
;--------------------------------------------------------------------
DEVICE S %ZIS("A")="Select LABEL PRINTER DEVICE: ",%IS="P" W ! D ^%ZIS
Q:POP I $E(IOST)'="P" D G DEVICE
.W *7,!?5,"<<< PLEASE SELECT A PRINTING DEVICE OR ""^"" TO EXIT >>>"
I $D(IO("S"))=1 X ^%ZIS(2,IO("S"),11)
U IO(0) W !!,"Please make sure labels have been put into the printer."
U IO(0) W !,"Press [RETURN] when you are ready... " R X:DTIME
S ABPA("IO")=IO K %ZIS("A"),%IS U IO(0) W !!
Q
;--------------------------------------------------------------------
PRINT S FLBL="",NAME=0 F ABPAI=0:0 D Q:NAME=""
.S NAME=$O(^%ZTSK(ZTSK,"INSURER",NAME)) Q:NAME=""
.S ABPADFN=0 F ABPAJ=0:0 D Q:+ABPADFN=0
..S ABPADFN=$O(^%ZTSK(ZTSK,"INSURER",NAME,ABPADFN)) Q:+ABPADFN=0
..K ADDR,CITY,STATE,ZIP,DATA
..S R=ABPADFN S DATA=^AUTNINS(R,0)
..S ADDR=$P(DATA,"^",2),CITY=$P(DATA,"^",3),STATE="",PTR=$P(DATA,"^",4)
..I +PTR>0 I $D(^DIC(5,PTR,0))=1 S STATE=$P(^DIC(5,PTR,0),"^",2)
..S ZIP=$P(DATA,"^",5) I $D(FLBL)=1 D
...F J=0:0 D Q:$D(FLBL)'=1
....I $D(IO("S"))=1 X ^%ZIS(2,IO("S"),10) H 2
....F K=1:1:2 U IO W NAME,!,ADDR,!,CITY,", ",STATE," ",ZIP,!!!!
....H 2 I $D(IO("S"))=1 X ^%ZIS(2,IO("S"),11) H 2
....U IO(0) W !!,"ARE YOUR LABELS LINED UP" S %=2 D YN^DICN
....U IO(0) W !!
....I +%'=1 D
.....U IO(0) W "Please adjust...press [RETURN] when ready"
.....U IO(0) R X:DTIME U IO(0) W !!
....I +%=1 U IO(0) D WAIT^DICD D
.....K FLBL I $D(IO("S"))=1 X ^%ZIS(2,IO("S"),10) H 2
..F J=1:1:2 U IO W NAME,!,ADDR,!,CITY,", ",STATE," ",ZIP,!!!!
..H 1
Q
;--------------------------------------------------------------------
CLOSE H 2 I $D(IO("S"))=1 X ^%ZIS(2,IO("S"),11)
X ^%ZIS("C") K IOP,IO("S") U IO(0) W !!
Q
;--------------------------------------------------------------------
ZTLEND ;PROCEDURE TO KILL ALL LOCALLY USED TEMPORARY VARIABLES
K %DT,%ZIS,%IS,ZTSK,X,Y,BDT,EDT,FAC,ZTRTN,ZTSAVE,ZTIO,ZTDESC,ABPA
K DIC,%,IOP,I,DIR
Q
;--------------------------------------------------------------------
MAIN ;ENTRY POINT - THE STARTING POINT FOR ENTERING THIS PROGRAM
D ZTLEND,HEAD,TASK I $D(ZTSK)'=1 D ZTLEND Q
D DEVICE I $D(ABPA("IO"))'=1 D ZTLEND Q
D PRINT,CLOSE,ZTLEND
Q
ABPAAGEL ;PRINT MAILING LABELS FOR OUTSTANDING BILLS; [ 07/25/91 11:10 AM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
+2 WRITE !!,"<<< SORRY, ACCESS DENIED!!! >>>",!!
GOTO ZTLEND
+3 ;--------------------------------------------------------------------
HEAD ;PROCEDURE TO DRAW SCREEN HEADING
+1 KILL ABPA("HD")
SET ABPA("HD",1)=ABPATLE
+2 SET ABPA("HD",2)="Print MAILING LABELS for outstanding bills"
DO ^ABPAHD
+3 QUIT
+4 ;--------------------------------------------------------------------
TASK KILL DIR
SET DIR(0)="NO"
SET DIR("A")="Select REPORT TASK NUMBER"
WRITE !!
DO ^DIR
+1 KILL ZTSK
IF Y
SET ZTSK=+Y
+2 IF '$TEST
Begin DoDot:1
+3 KILL ABPAMESS
SET ABPAMESS="NO TASK SELECTED - JOB ABORTED"
+4 SET ABPAMESS(2)="... Press any key to continue ..."
DO PAUSE^ABPAMAIN
End DoDot:1
QUIT
+5 IF $DATA(^%ZTSK(ZTSK,0))'=11
WRITE *7,!?5,"<<< TASK NOT FOUND >>>"
GOTO TASK
+6 SET ZTRTN=$PIECE(^%ZTSK(ZTSK,0),"^",1,2)
IF ZTRTN'="MAIN^ABPAAGE2"
Begin DoDot:1
+7 WRITE *7,!?5,"<<< INVALID TASK NUMBER >>>"
End DoDot:1
GOTO TASK
+8 IF $DATA(^%ZTSK(ZTSK,0,"ZTN"))'=1
Begin DoDot:1
+9 WRITE *7,!?5,"<<< MISSING NODE FROM THE TASK FILE >>>"
End DoDot:1
GOTO TASK
+10 SET ZTSK=+^%ZTSK(ZTSK,0,"ZTN")
IF $DATA(^%ZTSK(ZTSK,"INSURER"))'=10
Begin DoDot:1
+11 WRITE *7,!?5,"<<< MISSING NODE FROM THE TASK FILE >>>"
End DoDot:1
GOTO TASK
+12 QUIT
+13 ;--------------------------------------------------------------------
DEVICE SET %ZIS("A")="Select LABEL PRINTER DEVICE: "
SET %IS="P"
WRITE !
DO ^%ZIS
+1 IF POP
QUIT
IF $EXTRACT(IOST)'="P"
Begin DoDot:1
+2 WRITE *7,!?5,"<<< PLEASE SELECT A PRINTING DEVICE OR ""^"" TO EXIT >>>"
End DoDot:1
GOTO DEVICE
+3 IF $DATA(IO("S"))=1
XECUTE ^%ZIS(2,IO("S"),11)
+4 USE IO(0)
WRITE !!,"Please make sure labels have been put into the printer."
+5 USE IO(0)
WRITE !,"Press [RETURN] when you are ready... "
READ X:DTIME
+6 SET ABPA("IO")=IO
KILL %ZIS("A"),%IS
USE IO(0)
WRITE !!
+7 QUIT
+8 ;--------------------------------------------------------------------
PRINT SET FLBL=""
SET NAME=0
FOR ABPAI=0:0
Begin DoDot:1
+1 SET NAME=$ORDER(^%ZTSK(ZTSK,"INSURER",NAME))
IF NAME=""
QUIT
+2 SET ABPADFN=0
FOR ABPAJ=0:0
Begin DoDot:2
+3 SET ABPADFN=$ORDER(^%ZTSK(ZTSK,"INSURER",NAME,ABPADFN))
IF +ABPADFN=0
QUIT
+4 KILL ADDR,CITY,STATE,ZIP,DATA
+5 SET R=ABPADFN
SET DATA=^AUTNINS(R,0)
+6 SET ADDR=$PIECE(DATA,"^",2)
SET CITY=$PIECE(DATA,"^",3)
SET STATE=""
SET PTR=$PIECE(DATA,"^",4)
+7 IF +PTR>0
IF $DATA(^DIC(5,PTR,0))=1
SET STATE=$PIECE(^DIC(5,PTR,0),"^",2)
+8 SET ZIP=$PIECE(DATA,"^",5)
IF $DATA(FLBL)=1
Begin DoDot:3
+9 FOR J=0:0
Begin DoDot:4
+10 IF $DATA(IO("S"))=1
XECUTE ^%ZIS(2,IO("S"),10)
HANG 2
+11 FOR K=1:1:2
USE IO
WRITE NAME,!,ADDR,!,CITY,", ",STATE," ",ZIP,!!!!
+12 HANG 2
IF $DATA(IO("S"))=1
XECUTE ^%ZIS(2,IO("S"),11)
HANG 2
+13 USE IO(0)
WRITE !!,"ARE YOUR LABELS LINED UP"
SET %=2
DO YN^DICN
+14 USE IO(0)
WRITE !!
+15 IF +%'=1
Begin DoDot:5
+16 USE IO(0)
WRITE "Please adjust...press [RETURN] when ready"
+17 USE IO(0)
READ X:DTIME
USE IO(0)
WRITE !!
End DoDot:5
+18 IF +%=1
USE IO(0)
DO WAIT^DICD
Begin DoDot:5
+19 KILL FLBL
IF $DATA(IO("S"))=1
XECUTE ^%ZIS(2,IO("S"),10)
HANG 2
End DoDot:5
End DoDot:4
IF $DATA(FLBL)'=1
QUIT
End DoDot:3
+20 FOR J=1:1:2
USE IO
WRITE NAME,!,ADDR,!,CITY,", ",STATE," ",ZIP,!!!!
+21 HANG 1
End DoDot:2
IF +ABPADFN=0
QUIT
End DoDot:1
IF NAME=""
QUIT
+22 QUIT
+23 ;--------------------------------------------------------------------
CLOSE HANG 2
IF $DATA(IO("S"))=1
XECUTE ^%ZIS(2,IO("S"),11)
+1 XECUTE ^%ZIS("C")
KILL IOP,IO("S")
USE IO(0)
WRITE !!
+2 QUIT
+3 ;--------------------------------------------------------------------
ZTLEND ;PROCEDURE TO KILL ALL LOCALLY USED TEMPORARY VARIABLES
+1 KILL %DT,%ZIS,%IS,ZTSK,X,Y,BDT,EDT,FAC,ZTRTN,ZTSAVE,ZTIO,ZTDESC,ABPA
+2 KILL DIC,%,IOP,I,DIR
+3 QUIT
+4 ;--------------------------------------------------------------------
MAIN ;ENTRY POINT - THE STARTING POINT FOR ENTERING THIS PROGRAM
+1 DO ZTLEND
DO HEAD
DO TASK
IF $DATA(ZTSK)'=1
DO ZTLEND
QUIT
+2 DO DEVICE
IF $DATA(ABPA("IO"))'=1
DO ZTLEND
QUIT
+3 DO PRINT
DO CLOSE
DO ZTLEND
+4 QUIT
