- 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 ;
