Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACHSHV04

ACHSHV04.m

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