AFSHUT4 ; IHS/OIRM/DSD/JDM -AFSH PACKAGE SUBROUTINES (PRINTER SELECTION, ETC.) ; [ 10/27/2004 4:20 PM ]
;;3.0T1;AO FINANCIAL DATA MGMT SYSTEM;**13**;FEB 02, 1999
;;MODIFIED FOR CACHE' COMPLIANCE ;ACR*2.1*9
PTRDEF ;EP -- DEFINE PRINTERS AVAILABLE TO PROGRAM
B0 I '$D(^AUTTTEL(DUZ(2),5)) S AFSERMSG="DEFAULT PRINTER PORT NOT DEFINED -- JOB ABORTED" S AFSJFLG=1 G JCANCEL
S X=$P(^AUTTTEL(DUZ(2),5),"^",1),AFSDPRT=+X
S AFSVPRT(X)=X,AFSQ=0
B2 S AFSQ=$O(^AUTTTEL(DUZ(2),6,AFSQ)) G B2B:+AFSQ=0
S X=+$P(^AUTTTEL(DUZ(2),6,AFSQ,0),"^",1) S:X>0 AFSVPRT(X)=X
G B2
B2B Q
PTRSEL ;EP -- SELECT A DEFINED PRINTER
I $D(AFSVPRT(AFSDPRT)) S AFSSPRT=AFSDPRT
B4A W !!,"What PRINTER do you want to USE : "_AFSSPRT_"// " D SBRS^AFSHPRT1
I $D(DTOUT)!($D(DUOUT)) S AFSERMSG="PROGRAM AND/OR FUNCTION CANCELLED BY OPERATOR",AFSJFLG=1 G JCANCEL
I $D(DLOUT) S Y=AFSDPRT
I $D(DQOUT) D DSPVRT4^AFSHPRT1 G B4A
B4C I '$D(AFSVPRT(+Y)) W !!,*7,?10,"INVALID PRINTER NUMBER -- TRY AGAIN" G B4A
S AFSSPTR=+Y,IOP=+Y D ^%ZIS I IO="" W !!,*7,"PRINTER NOT AVAILABLE -- TRY LATER" H 3 G B4A
Q
JCANCEL U IO(0) W *7,!!,AFSERMSG,!,?10,"ENTER <RETURN> TO EXIT" S DX=$X+2,DY=$Y,%L=1,%F="A" D DAT1^AFSHCALL S AFSJFLG=1 Q
Q
PARMCHK ;EP; Subroutine moved from AFSTUT4 ACR*2.1*13.06 IM14144
K AFSJFLG
I '$D(AFSCCTR) S AFSERMSG="RECEIVING COMPUTER CENTER NOT DEFINED -- JOB ABORTED" G JCANCEL
I '$D(AFSPKGNM) S AFSERMSG="APPLICATION DATA TYPE NOT DEFINED -- JOB ABORTED" G JCANCEL
D USRCHK^AFSTUT3
I $D(AFSJFLG) G JCANCEL
I $L(AFSUXFPF)<2 S AFSERMSG="INVALID COMM. PARAMETER (UNIX FILENAME) -- JOB ABORTED" G JCANCEL
;S %SDIR="/usr/spool/"_AFSUXFPF_"data" ;ACR*2.1*13.06 IM14144
S %SDIR=$$ARMSDIR^ACRFSYS(1) ;ACR*2.1*13.06 IM14144
S %SDIR=%SDIR_AFSUXFPF_"data" ;ACR*2.1*13.06 IM14144
Q:AFSPKGNM?1"Z".E
I $D(AFSHDTNM),$E(AFSHDTNM,1,3)="DHR" G CNVRT
I AFSPKGNM="ACHS" G A7
I AFSPKGNM="AEQ" S AFSHDTNM="tx" G A7 ;pdw
I AFSPKGNM="AFSN" S AFSHDTNM="nu" G A7
I AFSPKGNM="AFSL" S AFSHDTNM=$S(AFSLPK1=1:"lud",1:"lut") G A7
I AFSPKGNM'="AFSH" S AFSHDTNM="ibm" G A7
I AFSPKGNM="AFSH"&('$D(AFSHDTNM)) S AFSERMSG="FINANCE DATA TYPE NOT DEFINED -- JOB ABORTED" G JCANCEL
CNVRT S X=$S(AFSHDTNM="DHRB":"dhb",AFSHDTNM="DHRP":"dhp",AFSHDTNM="PERP":"perp",AFSHDTNM="CANP":"canp",AFSHDTNM="DHRC":"dhc",1:"")
I X="" S AFSERMSG="FINANCE DATA TYPE IS INVALID -- JOB ABORTED" G JCANCEL
A4 S AFSHDTNM=X
I '$D(^DIC(9.4,AFSPKGPT,0)) S AFSERMSG="PACKAGE FILE PROBLEM -- JOB ABORTED" G JCANCEL
A7 U IO(0) D ^XBCLS
S AFSTXNAM=$P(^DIC(9.4,AFSPKGPT,0),"^",1)
I AFSPKGNM="AFSH" S X=$E(AFSHDTNM,1,2),X=$S(X="dh":"DOCUMENT HISTORY RECORD (DHR)",X="pe":"PERSONNEL C.A.N. CORRECTION",X="ca":"REQUEST FOR C.A.N."),AFSTXNAM="FINANCE "_X
S AFSTXNAM="FINANCE "_X G A9
A9 Q
AFSHUT4 ; IHS/OIRM/DSD/JDM -AFSH PACKAGE SUBROUTINES (PRINTER SELECTION, ETC.) ; [ 10/27/2004 4:20 PM ]
+1 ;;3.0T1;AO FINANCIAL DATA MGMT SYSTEM;**13**;FEB 02, 1999
+2 ;;MODIFIED FOR CACHE' COMPLIANCE ;ACR*2.1*9
PTRDEF ;EP -- DEFINE PRINTERS AVAILABLE TO PROGRAM
B0 IF '$DATA(^AUTTTEL(DUZ(2),5))
SET AFSERMSG="DEFAULT PRINTER PORT NOT DEFINED -- JOB ABORTED"
SET AFSJFLG=1
GOTO JCANCEL
+1 SET X=$PIECE(^AUTTTEL(DUZ(2),5),"^",1)
SET AFSDPRT=+X
+2 SET AFSVPRT(X)=X
SET AFSQ=0
B2 SET AFSQ=$ORDER(^AUTTTEL(DUZ(2),6,AFSQ))
IF +AFSQ=0
GOTO B2B
+1 SET X=+$PIECE(^AUTTTEL(DUZ(2),6,AFSQ,0),"^",1)
IF X>0
SET AFSVPRT(X)=X
+2 GOTO B2
B2B QUIT
PTRSEL ;EP -- SELECT A DEFINED PRINTER
+1 IF $DATA(AFSVPRT(AFSDPRT))
SET AFSSPRT=AFSDPRT
B4A WRITE !!,"What PRINTER do you want to USE : "_AFSSPRT_"// "
DO SBRS^AFSHPRT1
+1 IF $DATA(DTOUT)!($DATA(DUOUT))
SET AFSERMSG="PROGRAM AND/OR FUNCTION CANCELLED BY OPERATOR"
SET AFSJFLG=1
GOTO JCANCEL
+2 IF $DATA(DLOUT)
SET Y=AFSDPRT
+3 IF $DATA(DQOUT)
DO DSPVRT4^AFSHPRT1
GOTO B4A
B4C IF '$DATA(AFSVPRT(+Y))
WRITE !!,*7,?10,"INVALID PRINTER NUMBER -- TRY AGAIN"
GOTO B4A
+1 SET AFSSPTR=+Y
SET IOP=+Y
DO ^%ZIS
IF IO=""
WRITE !!,*7,"PRINTER NOT AVAILABLE -- TRY LATER"
HANG 3
GOTO B4A
+2 QUIT
JCANCEL USE IO(0)
WRITE *7,!!,AFSERMSG,!,?10,"ENTER <RETURN> TO EXIT"
SET DX=$X+2
SET DY=$Y
SET %L=1
SET %F="A"
DO DAT1^AFSHCALL
SET AFSJFLG=1
QUIT
+1 QUIT
PARMCHK ;EP; Subroutine moved from AFSTUT4 ACR*2.1*13.06 IM14144
+1 KILL AFSJFLG
+2 IF '$DATA(AFSCCTR)
SET AFSERMSG="RECEIVING COMPUTER CENTER NOT DEFINED -- JOB ABORTED"
GOTO JCANCEL
+3 IF '$DATA(AFSPKGNM)
SET AFSERMSG="APPLICATION DATA TYPE NOT DEFINED -- JOB ABORTED"
GOTO JCANCEL
+4 DO USRCHK^AFSTUT3
+5 IF $DATA(AFSJFLG)
GOTO JCANCEL
+6 IF $LENGTH(AFSUXFPF)<2
SET AFSERMSG="INVALID COMM. PARAMETER (UNIX FILENAME) -- JOB ABORTED"
GOTO JCANCEL
+7 ;S %SDIR="/usr/spool/"_AFSUXFPF_"data" ;ACR*2.1*13.06 IM14144
+8 ;ACR*2.1*13.06 IM14144
SET %SDIR=$$ARMSDIR^ACRFSYS(1)
+9 ;ACR*2.1*13.06 IM14144
SET %SDIR=%SDIR_AFSUXFPF_"data"
+10 IF AFSPKGNM?1"Z".E
QUIT
+11 IF $DATA(AFSHDTNM)
IF $EXTRACT(AFSHDTNM,1,3)="DHR"
GOTO CNVRT
+12 IF AFSPKGNM="ACHS"
GOTO A7
+13 ;pdw
IF AFSPKGNM="AEQ"
SET AFSHDTNM="tx"
GOTO A7
+14 IF AFSPKGNM="AFSN"
SET AFSHDTNM="nu"
GOTO A7
+15 IF AFSPKGNM="AFSL"
SET AFSHDTNM=$SELECT(AFSLPK1=1:"lud",1:"lut")
GOTO A7
+16 IF AFSPKGNM'="AFSH"
SET AFSHDTNM="ibm"
GOTO A7
+17 IF AFSPKGNM="AFSH"&('$DATA(AFSHDTNM))
SET AFSERMSG="FINANCE DATA TYPE NOT DEFINED -- JOB ABORTED"
GOTO JCANCEL
CNVRT SET X=$SELECT(AFSHDTNM="DHRB":"dhb",AFSHDTNM="DHRP":"dhp",AFSHDTNM="PERP":"perp",AFSHDTNM="CANP":"canp",AFSHDTNM="DHRC":"dhc",1:"")
+1 IF X=""
SET AFSERMSG="FINANCE DATA TYPE IS INVALID -- JOB ABORTED"
GOTO JCANCEL
A4 SET AFSHDTNM=X
+1 IF '$DATA(^DIC(9.4,AFSPKGPT,0))
SET AFSERMSG="PACKAGE FILE PROBLEM -- JOB ABORTED"
GOTO JCANCEL
A7 USE IO(0)
DO ^XBCLS
+1 SET AFSTXNAM=$PIECE(^DIC(9.4,AFSPKGPT,0),"^",1)
+2 IF AFSPKGNM="AFSH"
SET X=$EXTRACT(AFSHDTNM,1,2)
SET X=$SELECT(X="dh":"DOCUMENT HISTORY RECORD (DHR)",X="pe":"PERSONNEL C.A.N. CORRECTION",X="ca":"REQUEST FOR C.A.N.")
SET AFSTXNAM="FINANCE "_X
+3 SET AFSTXNAM="FINANCE "_X
GOTO A9
A9 QUIT
