- 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
