ACHSTUT2 ; IHS/ITSC/TPF/PMF - CHECK/COPY/PURGE 3780.LOG UNIX FILE ;
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**22**;JUN 11, 2001;Build 43
;ACHS*3.1*22 OS test when writing to a directory
;
S ACHSHCMD="cd /usr/bin/3780;ls -l 3780.LOG | awk '{print $5}' > /usr/spool/3780/3780.logsize"
S ACHSRTCD=$$TERMINAL^ACHSHCMD(ACHSHCMD)
I $$OPEN^%ZISH("/usr/spool/3780/","3780.logsize","R") S ACHSEMSG="M10" D ERROR^ACHSTCK1 G ABEND
S ACHSFS1=IO
U ACHSFS1
R ACHSLGSZ:1
G ABEND:'$T
I $D(ACHSFS1) S IO=ACHSFS1,IONOFF="" D ^%ZISC
I ACHSLGSZ>50000 D
.S ACHSHCMD="cd /usr/bin/3780;cp 3780.LOG 3780.LOG.BK;rm 3780.LOG;echo """" > 3780.LOG;cd /usr/mumps"
.S ACHSRTCD=$$TERMINAL^ACHSHCMD(ACHSHCMD)
ABEND ;
K ACHSZDEV,ACHSCMD,X,ACHSFS1,ACHSLGSZ
Q
;
PARMCHK ;EP
K ACHSJFLG
I '$D(ACHSCCTR) S ACHSEMSG="RECEIVING COMPUTER CENTER NOT DEFINED -- JOB ABORTED" D JCANCEL Q
I '$D(ACHSPGNM) S ACHSEMSG="APPLICATION DATA TYPE NOT DEFINED -- JOB ABORTED" D JCANCEL Q
D USRCHK
I $D(ACHSJFLG) D JCANCEL Q
I $L(ACHSUXFP)<2 S ACHSEMSG="INVALID COMM. PARAMETER (UNIX FILENAME) -- JOB ABORTED" D JCANCEL Q
;S ACHSZDIR="/usr/spool/"_ACHSUXFP_"data" ;ACHS*3.1*22
S ACHSZDIR=$S($$OS^ACHS=2:"c:\usr\spool\chsdata",1:"/usr/spool/chsdata") ;ACHS*3.1*22 OIT/IHS.FCJ
Q:ACHSPGNM?1"Z".E
I $E($G(ACHSHDNM),1,3)="DHR" G CNVRT
I ACHSPGNM="ACHS" G A7
I ACHSPGNM="ACHSN" S ACHSHDNM="nu" G A7
I ACHSPGNM="AFSL" S ACHSHDNM="lu" G A7
I ACHSPGNM'="AFSH" S ACHSHDNM="ibm" G A7
I ACHSPGNM="AFSH",'$D(ACHSHDNM) S ACHSEMSG="FINANCE DATA TYPE NOT DEFINED -- JOB ABORTED" D JCANCEL Q
CNVRT ;
S X=$S(ACHSHDNM="DHRB":"dhb",ACHSHDNM="DHRP":"dhp",ACHSHDNM="PERP":"perp",ACHSHDNM="CANP":"canp",ACHSHDNM="DHRC":"dhc",1:"")
I X="" S ACHSEMSG="FINANCE DATA TYPE IS INVALID -- JOB ABORTED" D JCANCEL Q
S ACHSHDNM=X
I '$D(^DIC(9.4,ACHSPGPT,0)) S ACHSEMSG="PACKAGE FILE PROBLEM -- JOB ABORTED" D JCANCEL Q
A7 ;
U IO
S ACHSTXNM=$P(^DIC(9.4,ACHSPGPT,0),U,1)
I ACHSPGNM="AFSH" S X=$E(ACHSHDNM,1,2),X=$S(X="dh":"DOCUMENT HISTORY RECORD (DHR)",X="pe":"PERSONNEL C.A.N. CORRECTION",X="ca":"REQUEST FOR C.A.N."),ACHSTXNM="FINANCE "_X
S ACHSTXNM="FINANCE "_X
Q
;
JCANCEL ;
U IO(0)
W *7,!!,ACHSEMSG,!
I $$DIR^XBDIR("E","ENTER <RETURN> TO EXIT")
S ACHSJFLG=1
Q
;
USRCHK ; -- Set User-ID & Password for the selected Package.
K ACHSJFLG
I ACHSPGNM?1"Z".E,ACHSPGNM="Z638" S ACHSUXFP="chs",ACHSHDNM="638",ACHSTXNM="CHS 638 STAT." Q
S X=ACHSPGNM,DIC(0)="",D="C",DIC=9.4
D IX^DIC
I +Y<0 D SETERR("M14") Q
I '$D(^AUTTTEL(DUZ(2),4,"B",+Y)) D SETERR("M14") Q
S ACHSR=""
S ACHSR=$O(^AUTTTEL(DUZ(2),4,"B",+Y,ACHSR))
S Y=$G(^AUTTTEL(DUZ(2),4,ACHSR,0))
F %=2,3,4,6 I $P(Y,U,%)="" D SETERR("M13") Q
Q:$G(ACHSJFLG)
I ACHSPGNM'="AFSP",$P(Y,U,5)="" D SETERR("M13") Q
I ACHSPGNM'="AFSH",$P(Y,U,7)="" D SETERR("M13") Q
S ACHSUID=$P(Y,U,4),ACHSPSWD=$P(Y,U,3),ACHSJNPF=$P(Y,U,2),ACHSUXFP=$E($P(Y,U,5),1,3),ACHSPKCU=$P(Y,U,6),ACHSFNPF=$P(Y,U,5),ACHSPGPT=+Y,ACHSCTRP="",ACHSCTRP=$O(^AUTTTEL(DUZ(2),1,"B",ACHSCCTR,ACHSCTRP)),ACHSDEST=ACHSCCTR
I +ACHSCTRP<1 D SETERR("M1") Q
I '$D(^AUTTTEL(DUZ(2),1,ACHSCTRP,0)) D SETERR("M2") Q
S ACHSPRRN=$P(^AUTTTEL(DUZ(2),1,ACHSCTRP,0),U,2),ACHSPRPW=$P(^(0),U,3)
Q
;
SETERR(%) ;
S ACHSEMSG=$P($T(@%^ACHSTCK1),";;",2),ACHSJFLG=1
Q
;
ACHSTUT2 ; IHS/ITSC/TPF/PMF - CHECK/COPY/PURGE 3780.LOG UNIX FILE ;
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**22**;JUN 11, 2001;Build 43
+2 ;ACHS*3.1*22 OS test when writing to a directory
+3 ;
+4 SET ACHSHCMD="cd /usr/bin/3780;ls -l 3780.LOG | awk '{print $5}' > /usr/spool/3780/3780.logsize"
+5 SET ACHSRTCD=$$TERMINAL^ACHSHCMD(ACHSHCMD)
+6 IF $$OPEN^%ZISH("/usr/spool/3780/","3780.logsize","R")
SET ACHSEMSG="M10"
DO ERROR^ACHSTCK1
GOTO ABEND
+7 SET ACHSFS1=IO
+8 USE ACHSFS1
+9 READ ACHSLGSZ:1
+10 IF '$TEST
GOTO ABEND
+11 IF $DATA(ACHSFS1)
SET IO=ACHSFS1
SET IONOFF=""
DO ^%ZISC
+12 IF ACHSLGSZ>50000
Begin DoDot:1
+13 SET ACHSHCMD="cd /usr/bin/3780;cp 3780.LOG 3780.LOG.BK;rm 3780.LOG;echo """" > 3780.LOG;cd /usr/mumps"
+14 SET ACHSRTCD=$$TERMINAL^ACHSHCMD(ACHSHCMD)
End DoDot:1
ABEND ;
+1 KILL ACHSZDEV,ACHSCMD,X,ACHSFS1,ACHSLGSZ
+2 QUIT
+3 ;
PARMCHK ;EP
+1 KILL ACHSJFLG
+2 IF '$DATA(ACHSCCTR)
SET ACHSEMSG="RECEIVING COMPUTER CENTER NOT DEFINED -- JOB ABORTED"
DO JCANCEL
QUIT
+3 IF '$DATA(ACHSPGNM)
SET ACHSEMSG="APPLICATION DATA TYPE NOT DEFINED -- JOB ABORTED"
DO JCANCEL
QUIT
+4 DO USRCHK
+5 IF $DATA(ACHSJFLG)
DO JCANCEL
QUIT
+6 IF $LENGTH(ACHSUXFP)<2
SET ACHSEMSG="INVALID COMM. PARAMETER (UNIX FILENAME) -- JOB ABORTED"
DO JCANCEL
QUIT
+7 ;S ACHSZDIR="/usr/spool/"_ACHSUXFP_"data" ;ACHS*3.1*22
+8 ;ACHS*3.1*22 OIT/IHS.FCJ
SET ACHSZDIR=$SELECT($$OS^ACHS=2:"c:\usr\spool\chsdata",1:"/usr/spool/chsdata")
+9 IF ACHSPGNM?1"Z".E
QUIT
+10 IF $EXTRACT($GET(ACHSHDNM),1,3)="DHR"
GOTO CNVRT
+11 IF ACHSPGNM="ACHS"
GOTO A7
+12 IF ACHSPGNM="ACHSN"
SET ACHSHDNM="nu"
GOTO A7
+13 IF ACHSPGNM="AFSL"
SET ACHSHDNM="lu"
GOTO A7
+14 IF ACHSPGNM'="AFSH"
SET ACHSHDNM="ibm"
GOTO A7
+15 IF ACHSPGNM="AFSH"
IF '$DATA(ACHSHDNM)
SET ACHSEMSG="FINANCE DATA TYPE NOT DEFINED -- JOB ABORTED"
DO JCANCEL
QUIT
CNVRT ;
+1 SET X=$SELECT(ACHSHDNM="DHRB":"dhb",ACHSHDNM="DHRP":"dhp",ACHSHDNM="PERP":"perp",ACHSHDNM="CANP":"canp",ACHSHDNM="DHRC":"dhc",1:"")
+2 IF X=""
SET ACHSEMSG="FINANCE DATA TYPE IS INVALID -- JOB ABORTED"
DO JCANCEL
QUIT
+3 SET ACHSHDNM=X
+4 IF '$DATA(^DIC(9.4,ACHSPGPT,0))
SET ACHSEMSG="PACKAGE FILE PROBLEM -- JOB ABORTED"
DO JCANCEL
QUIT
A7 ;
+1 USE IO
+2 SET ACHSTXNM=$PIECE(^DIC(9.4,ACHSPGPT,0),U,1)
+3 IF ACHSPGNM="AFSH"
SET X=$EXTRACT(ACHSHDNM,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 ACHSTXNM="FINANCE "_X
+4 SET ACHSTXNM="FINANCE "_X
+5 QUIT
+6 ;
JCANCEL ;
+1 USE IO(0)
+2 WRITE *7,!!,ACHSEMSG,!
+3 IF $$DIR^XBDIR("E","ENTER <RETURN> TO EXIT")
+4 SET ACHSJFLG=1
+5 QUIT
+6 ;
USRCHK ; -- Set User-ID & Password for the selected Package.
+1 KILL ACHSJFLG
+2 IF ACHSPGNM?1"Z".E
IF ACHSPGNM="Z638"
SET ACHSUXFP="chs"
SET ACHSHDNM="638"
SET ACHSTXNM="CHS 638 STAT."
QUIT
+3 SET X=ACHSPGNM
SET DIC(0)=""
SET D="C"
SET DIC=9.4
+4 DO IX^DIC
+5 IF +Y<0
DO SETERR("M14")
QUIT
+6 IF '$DATA(^AUTTTEL(DUZ(2),4,"B",+Y))
DO SETERR("M14")
QUIT
+7 SET ACHSR=""
+8 SET ACHSR=$ORDER(^AUTTTEL(DUZ(2),4,"B",+Y,ACHSR))
+9 SET Y=$GET(^AUTTTEL(DUZ(2),4,ACHSR,0))
+10 FOR %=2,3,4,6
IF $PIECE(Y,U,%)=""
DO SETERR("M13")
QUIT
+11 IF $GET(ACHSJFLG)
QUIT
+12 IF ACHSPGNM'="AFSP"
IF $PIECE(Y,U,5)=""
DO SETERR("M13")
QUIT
+13 IF ACHSPGNM'="AFSH"
IF $PIECE(Y,U,7)=""
DO SETERR("M13")
QUIT
+14 SET ACHSUID=$PIECE(Y,U,4)
SET ACHSPSWD=$PIECE(Y,U,3)
SET ACHSJNPF=$PIECE(Y,U,2)
SET ACHSUXFP=$EXTRACT($PIECE(Y,U,5),1,3)
SET ACHSPKCU=$PIECE(Y,U,6)
SET ACHSFNPF=$PIECE(Y,U,5)
SET ACHSPGPT=+Y
SET ACHSCTRP=""
SET ACHSCTRP=$ORDER(^AUTTTEL(DUZ(2),1,"B",ACHSCCTR,ACHSCTRP))
SET ACHSDEST=ACHSCCTR
+15 IF +ACHSCTRP<1
DO SETERR("M1")
QUIT
+16 IF '$DATA(^AUTTTEL(DUZ(2),1,ACHSCTRP,0))
DO SETERR("M2")
QUIT
+17 SET ACHSPRRN=$PIECE(^AUTTTEL(DUZ(2),1,ACHSCTRP,0),U,2)
SET ACHSPRPW=$PIECE(^(0),U,3)
+18 QUIT
+19 ;
SETERR(%) ;
+1 SET ACHSEMSG=$PIECE($TEXT(@%^ACHSTCK1),";;",2)
SET ACHSJFLG=1
+2 QUIT
+3 ;
