ACHSHV04 ; IHS/ITSC/PMF - PRINT/PROCESS HV NOTIFICATION DATA ; [ 06/27/2003 8:35 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
D HOME^%ZIS
S ACHSHMD=IO(0)
U ACHSHMD
W !,$$C^XBFUNC("Just a moment -- Reading File Information",70),!
A0 ; Mail Loop.
D ^ACHSHVRC
G:$G(ACHSJFLG) END
A1 ; Display name of vendors that reports exist for.
S (ACHSR,ACHSRR,ACHSCT)=0
U ACHSHMD
W !!?5,"NOTIFICATION REPORTS EXIST FOR THE FOLLOWING VENDORS: ",!!
A2 ;
K ACHSCTZ
A2A ;
S ACHSR=$O(^ACHSHVLG("C",ACHSR))
G A5:+ACHSR=0
S ACHSCT=ACHSCT+1,ACHSCTZ(ACHSCT)=ACHSR,ACHSFN=$E($P(^AUTTVNDR(ACHSR,0),U,1),1,30)
U ACHSHMD
W ?5,ACHSCT,?10,ACHSFN,!
G A2A
;
A5 ; Ask user to pick vendor.
I 'ACHSCT U IO(0) W !?10,"NONE FOUND..." S %=$$DIR^XBDIR("E","Press RETURN...") G ENDZ
S X=$$DIR^XBDIR("N^1:"_ACHSCT,"Enter Number of Vendor to Print/Process","","","","",1)
I $D(DUOUT)!($D(DTOUT)) G ENDZ
S ACHSV=ACHSCTZ(X)
K ACHSCTZ
S ACHSCNT=0
FILDPSC ; Display file info about selected vendor.
S (ACHSR,ACHSRR,ACHSDELD,ACHSCNT,ACHSDSAV)=0
K ACHSCTZ
S X="",$P(X,"-",73)=""
U ACHSHMD
W !!,X,!," #",?5,"UNIX FILE",?17,"REPORT",?25,"REPORT DATE",?38,"# RCDS",?46,"LAST PRINTED",?60,"PROCESS DATE",!,X,!
FILDPSC1 ;
S ACHSR=$O(^ACHSHVLG("C",ACHSV,ACHSR))
G FILDPSF:+ACHSR=0
FILDPSC2 ;
S ACHSRR=$O(^ACHSHVLG("C",ACHSV,ACHSR,ACHSRR))
G FILDPSC1:+ACHSRR=0
S ACHSCNT=ACHSCNT+1,ACHSCTZ(ACHSCNT)=ACHSRR
W !,$J(ACHSCNT,3),?5,$P(^ACHSHVLG(ACHSV,1,ACHSRR,0),U,4)
S X=$P(^ACHSHVLG(ACHSV,1,ACHSRR,0),U,2)
W ?17,$S(X="O":"OUTPAT",X="D":"DENTAL",X="I":"INPAT",1:"UNKNWN")
S Y=$P(^ACHSHVLG(ACHSV,1,ACHSRR,0),U,1)
D DD^%DT
W ?25,Y,?38,$J($P(^ACHSHVLG(ACHSV,1,ACHSRR,0),U,3),5)
S Y=$P(^ACHSHVLG(ACHSV,1,ACHSRR,0),U,5)
G:+Y=0 FILDSKP6
D DD^%DT
W ?46,Y
FILDSKP6 ;
S Y=$P(^ACHSHVLG(ACHSV,1,ACHSRR,0),U,6)
G FILDSKP7:+Y=0
D DD^%DT
W ?60,Y
FILDSKP7 ;
G FILDPSC2
;
FILDPSF ; Ask user to pick file.
U ACHSHMD
S X=$$DIR^XBDIR("N^1:"_ACHSCNT,"Enter Number of Notification File to Print/Scan for Errors","","","","",1)
I $D(DUOUT)!($D(DTOUT)) G A1
S ACHSNO=ACHSCTZ(X)
B2 ; Ask user to PRINT or SCAN FOR ERRORS.
S Y=$$DIR^XBDIR("S^1:PRINT;2:SCAN REPORT FOR ERRORS")
I $D(DUOUT)!($D(DTOUT)) G FILDPSC
G PRINTSEL:Y=1,PROCESS:Y=2
Q
;
PRINTSEL ; Select printer for report.
U ACHSHMD
W !!
S %ZIS="NP",%ZIS("A")="Print report on which Printer: "
D ^%ZIS
K %ZIS
I POP U ACHSHMD W !,*7,"Device Not Available -- Job Aborted" G END
I $D(IO("S")) U IO(0) W !!,*7,?10,"Selection of Slave Printer not allowed -- Please Select Again" G PRINTSEL
S ACHSPTRN=ION
I IOM<132 W !!,*7,"Device Right Margin < 132 Char -- Select another Device" G PRINTSEL
S ACHSPRT=IO
D CHK16^ACHSPS16
G A0:$D(DUOUT)
I '$D(ACHS("PRINT","ERROR")) G A7A
G A0:$$DIR^XBDIR("E"),END
;
A7A ;
U IO(0)
W !!?10,"Your Request is now being Processed",!
A7B ;
S IOP=ACHSPTRN
D ^%ZIS
I POP U IO(0) W !!,"Device Unavailable" G END
A7C ;
I $D(ACHS("PRINT",16)) U ACHSPRT W @ACHS("PRINT",16)
S ACHSRCT=0
K ACHSKILL
S ACHSZFN=$$AOP^ACHS(2,1)_$P(^ACHSHVLG(ACHSV,1,ACHSNO,0),U,4)
I $$OPEN^%ZISH($$AOP^ACHS(2,1),$P(^ACHSHVLG(ACHSV,1,ACHSNO,0),U,4),"R") S ACHSEMSG="M10" D ERROR^ACHSTCK1 G END
S ACHSHFS1=IO
U ACHSHMD
W !!
F ACHSI=1:1 U ACHSHFS1 R ACHSLINE:1 G SUSPEND:'$T G PREOF:$$STATUS^%ZISH D PRINT G SUSPEND:$D(ACHSKILL)
Q
;
PREOF ;
U ACHSHMD
W !!,"PRINTING HAS COMPLETED "
I $D(^ACHSHVLG(ACHSV,1,ACHSNO,0)) S $P(^(0),U,5)=DT
I $$DIR^XBDIR("E","Press <RETURN> To Continue....")
G A1
;
PRINT ; Check if user has pressed ESC, else print line.
S ACHSRCT=ACHSRCT+1
I (ACHSRCT#60)=0 G PRINTC
G PRINTR
;
PRINTC ;
U ACHSHMD
R *ACHSESC:1 ; Exception for star read.
I ACHSESC=27 G PTRSTOP
PRINTR ;
U ACHSPRT
W ACHSLINE,!
Q
;
PTRSTOP ; User pressed ESC to suspend printing.
U ACHSHMD
W *7,*7,*7
F R ACHSESC:0 E Q ; Clear Keyboard buffer, if any.
I $$DIR^XBDIR("E","Enter <RETURN> to continue '^' to Cancel Printing","","","","",2)
I $D(DUOUT) S ACHSKILL=""
Q
;
SUSPEND ; User suspended printing.
U IO(0)
S Y=$$DIR^XBDIR("Y","Printing SUSPENDED -- Do you want to print other Reports","","","","",2)
I $D(DUOUT)!($D(DTOUT)) G END
I +Y=1 G FILDPSC
G A1
;
PROCESS ; Ensure OUTPAT report, then scan.
G PROCESSA:$P(^ACHSHVLG(ACHSV,1,ACHSNO,0),U,2)["O"
U IO(0)
W *7,!!?10,"Only Outpatient Reports can be Scanned for Errors"
H 3
G A1
;
PROCESSA ;
D ^ACHSHV01
G A1
;
END ; Reset printer from condensed print.
D 10^ACHSPS16
ENDZ ; Close device(s), kill vars, quit.
I $D(ACHSPRT) S IO=ACHSPRT D ^%ZISC
I $D(ACHSHFS1) S IO=ACHSHFS1 S IONOFF="" D ^%ZISC
D EN^XBVK("ACHS"),^ACHSVAR
K X,Y,DIC,DIR,DA,Z
Q
;
ACHSHV04 ; IHS/ITSC/PMF - PRINT/PROCESS HV NOTIFICATION DATA ; [ 06/27/2003 8:35 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
+3 DO HOME^%ZIS
+4 SET ACHSHMD=IO(0)
+5 USE ACHSHMD
+6 WRITE !,$$C^XBFUNC("Just a moment -- Reading File Information",70),!
A0 ; Mail Loop.
+1 DO ^ACHSHVRC
+2 IF $GET(ACHSJFLG)
GOTO END
A1 ; Display name of vendors that reports exist for.
+1 SET (ACHSR,ACHSRR,ACHSCT)=0
+2 USE ACHSHMD
+3 WRITE !!?5,"NOTIFICATION REPORTS EXIST FOR THE FOLLOWING VENDORS: ",!!
A2 ;
+1 KILL ACHSCTZ
A2A ;
+1 SET ACHSR=$ORDER(^ACHSHVLG("C",ACHSR))
+2 IF +ACHSR=0
GOTO A5
+3 SET ACHSCT=ACHSCT+1
SET ACHSCTZ(ACHSCT)=ACHSR
SET ACHSFN=$EXTRACT($PIECE(^AUTTVNDR(ACHSR,0),U,1),1,30)
+4 USE ACHSHMD
+5 WRITE ?5,ACHSCT,?10,ACHSFN,!
+6 GOTO A2A
+7 ;
A5 ; Ask user to pick vendor.
+1 IF 'ACHSCT
USE IO(0)
WRITE !?10,"NONE FOUND..."
SET %=$$DIR^XBDIR("E","Press RETURN...")
GOTO ENDZ
+2 SET X=$$DIR^XBDIR("N^1:"_ACHSCT,"Enter Number of Vendor to Print/Process","","","","",1)
+3 IF $DATA(DUOUT)!($DATA(DTOUT))
GOTO ENDZ
+4 SET ACHSV=ACHSCTZ(X)
+5 KILL ACHSCTZ
+6 SET ACHSCNT=0
FILDPSC ; Display file info about selected vendor.
+1 SET (ACHSR,ACHSRR,ACHSDELD,ACHSCNT,ACHSDSAV)=0
+2 KILL ACHSCTZ
+3 SET X=""
SET $PIECE(X,"-",73)=""
+4 USE ACHSHMD
+5 WRITE !!,X,!," #",?5,"UNIX FILE",?17,"REPORT",?25,"REPORT DATE",?38,"# RCDS",?46,"LAST PRINTED",?60,"PROCESS DATE",!,X,!
FILDPSC1 ;
+1 SET ACHSR=$ORDER(^ACHSHVLG("C",ACHSV,ACHSR))
+2 IF +ACHSR=0
GOTO FILDPSF
FILDPSC2 ;
+1 SET ACHSRR=$ORDER(^ACHSHVLG("C",ACHSV,ACHSR,ACHSRR))
+2 IF +ACHSRR=0
GOTO FILDPSC1
+3 SET ACHSCNT=ACHSCNT+1
SET ACHSCTZ(ACHSCNT)=ACHSRR
+4 WRITE !,$JUSTIFY(ACHSCNT,3),?5,$PIECE(^ACHSHVLG(ACHSV,1,ACHSRR,0),U,4)
+5 SET X=$PIECE(^ACHSHVLG(ACHSV,1,ACHSRR,0),U,2)
+6 WRITE ?17,$SELECT(X="O":"OUTPAT",X="D":"DENTAL",X="I":"INPAT",1:"UNKNWN")
+7 SET Y=$PIECE(^ACHSHVLG(ACHSV,1,ACHSRR,0),U,1)
+8 DO DD^%DT
+9 WRITE ?25,Y,?38,$JUSTIFY($PIECE(^ACHSHVLG(ACHSV,1,ACHSRR,0),U,3),5)
+10 SET Y=$PIECE(^ACHSHVLG(ACHSV,1,ACHSRR,0),U,5)
+11 IF +Y=0
GOTO FILDSKP6
+12 DO DD^%DT
+13 WRITE ?46,Y
FILDSKP6 ;
+1 SET Y=$PIECE(^ACHSHVLG(ACHSV,1,ACHSRR,0),U,6)
+2 IF +Y=0
GOTO FILDSKP7
+3 DO DD^%DT
+4 WRITE ?60,Y
FILDSKP7 ;
+1 GOTO FILDPSC2
+2 ;
FILDPSF ; Ask user to pick file.
+1 USE ACHSHMD
+2 SET X=$$DIR^XBDIR("N^1:"_ACHSCNT,"Enter Number of Notification File to Print/Scan for Errors","","","","",1)
+3 IF $DATA(DUOUT)!($DATA(DTOUT))
GOTO A1
+4 SET ACHSNO=ACHSCTZ(X)
B2 ; Ask user to PRINT or SCAN FOR ERRORS.
+1 SET Y=$$DIR^XBDIR("S^1:PRINT;2:SCAN REPORT FOR ERRORS")
+2 IF $DATA(DUOUT)!($DATA(DTOUT))
GOTO FILDPSC
+3 IF Y=1
GOTO PRINTSEL
IF Y=2
GOTO PROCESS
+4 QUIT
+5 ;
PRINTSEL ; Select printer for report.
+1 USE ACHSHMD
+2 WRITE !!
+3 SET %ZIS="NP"
SET %ZIS("A")="Print report on which Printer: "
+4 DO ^%ZIS
+5 KILL %ZIS
+6 IF POP
USE ACHSHMD
WRITE !,*7,"Device Not Available -- Job Aborted"
GOTO END
+7 IF $DATA(IO("S"))
USE IO(0)
WRITE !!,*7,?10,"Selection of Slave Printer not allowed -- Please Select Again"
GOTO PRINTSEL
+8 SET ACHSPTRN=ION
+9 IF IOM<132
WRITE !!,*7,"Device Right Margin < 132 Char -- Select another Device"
GOTO PRINTSEL
+10 SET ACHSPRT=IO
+11 DO CHK16^ACHSPS16
+12 IF $DATA(DUOUT)
GOTO A0
+13 IF '$DATA(ACHS("PRINT","ERROR"))
GOTO A7A
+14 IF $$DIR^XBDIR("E")
GOTO A0
GOTO END
+15 ;
A7A ;
+1 USE IO(0)
+2 WRITE !!?10,"Your Request is now being Processed",!
A7B ;
+1 SET IOP=ACHSPTRN
+2 DO ^%ZIS
+3 IF POP
USE IO(0)
WRITE !!,"Device Unavailable"
GOTO END
A7C ;
+1 IF $DATA(ACHS("PRINT",16))
USE ACHSPRT
WRITE @ACHS("PRINT",16)
+2 SET ACHSRCT=0
+3 KILL ACHSKILL
+4 SET ACHSZFN=$$AOP^ACHS(2,1)_$PIECE(^ACHSHVLG(ACHSV,1,ACHSNO,0),U,4)
+5 IF $$OPEN^%ZISH($$AOP^ACHS(2,1),$PIECE(^ACHSHVLG(ACHSV,1,ACHSNO,0),U,4),"R")
SET ACHSEMSG="M10"
DO ERROR^ACHSTCK1
GOTO END
+6 SET ACHSHFS1=IO
+7 USE ACHSHMD
+8 WRITE !!
+9 FOR ACHSI=1:1
USE ACHSHFS1
READ ACHSLINE:1
IF '$TEST
GOTO SUSPEND
IF $$STATUS^%ZISH
GOTO PREOF
DO PRINT
IF $DATA(ACHSKILL)
GOTO SUSPEND
+10 QUIT
+11 ;
PREOF ;
+1 USE ACHSHMD
+2 WRITE !!,"PRINTING HAS COMPLETED "
+3 IF $DATA(^ACHSHVLG(ACHSV,1,ACHSNO,0))
SET $PIECE(^(0),U,5)=DT
+4 IF $$DIR^XBDIR("E","Press <RETURN> To Continue....")
+5 GOTO A1
+6 ;
PRINT ; Check if user has pressed ESC, else print line.
+1 SET ACHSRCT=ACHSRCT+1
+2 IF (ACHSRCT#60)=0
GOTO PRINTC
+3 GOTO PRINTR
+4 ;
PRINTC ;
+1 USE ACHSHMD
+2 ; Exception for star read.
READ *ACHSESC:1
+3 IF ACHSESC=27
GOTO PTRSTOP
PRINTR ;
+1 USE ACHSPRT
+2 WRITE ACHSLINE,!
+3 QUIT
+4 ;
PTRSTOP ; User pressed ESC to suspend printing.
+1 USE ACHSHMD
+2 WRITE *7,*7,*7
+3 ; Clear Keyboard buffer, if any.
FOR
READ ACHSESC:0
IF '$TEST
QUIT
+4 IF $$DIR^XBDIR("E","Enter <RETURN> to continue '^' to Cancel Printing","","","","",2)
+5 IF $DATA(DUOUT)
SET ACHSKILL=""
+6 QUIT
+7 ;
SUSPEND ; User suspended printing.
+1 USE IO(0)
+2 SET Y=$$DIR^XBDIR("Y","Printing SUSPENDED -- Do you want to print other Reports","","","","",2)
+3 IF $DATA(DUOUT)!($DATA(DTOUT))
GOTO END
+4 IF +Y=1
GOTO FILDPSC
+5 GOTO A1
+6 ;
PROCESS ; Ensure OUTPAT report, then scan.
+1 IF $PIECE(^ACHSHVLG(ACHSV,1,ACHSNO,0),U,2)["O"
GOTO PROCESSA
+2 USE IO(0)
+3 WRITE *7,!!?10,"Only Outpatient Reports can be Scanned for Errors"
+4 HANG 3
+5 GOTO A1
+6 ;
PROCESSA ;
+1 DO ^ACHSHV01
+2 GOTO A1
+3 ;
END ; Reset printer from condensed print.
+1 DO 10^ACHSPS16
ENDZ ; Close device(s), kill vars, quit.
+1 IF $DATA(ACHSPRT)
SET IO=ACHSPRT
DO ^%ZISC
+2 IF $DATA(ACHSHFS1)
SET IO=ACHSHFS1
SET IONOFF=""
DO ^%ZISC
+3 DO EN^XBVK("ACHS")
DO ^ACHSVAR
+4 KILL X,Y,DIC,DIR,DA,Z
+5 QUIT
+6 ;
