PSXDODAT ;BRM/PDW-DOD PROCESS/FILE AUTO-SCHEDULING INFORMATION ;09/09/02 11:15 AM
;;2.0;CMOP;**38,45**;11 Apr 97
Q
EN(PATH,FNAME) ; needs directory & file name
I $L(PATH),$L(FNAME) I 1
E S PSXERR="0^BAD PATH OR FILENAME" G ERRMSG
K ^TMP($J,"PSXDOD")
S FNAME1=FNAME
S GBL="^TMP("_$J_",""PSXDOD"",1)"
S Y=$$FTG^%ZISH(PATH,FNAME,$NA(^TMP($J,"PSXDOD",1)),3)
I Y'>0 S PSXERR="9^"_PATH_U_FNAME_U_" DID NOT LOAD" G ERRMSG
I $D(^TMP($J,"PSXDOD"))'>1 S PSXERR="9^"_PATH_U_FNAME_U_" DID NOT LOAD" G ERRMSG
EN1 ;
K PSXERR
S (MSH,MSH1)=^TMP($J,"PSXDOD",1),ARQ=^TMP($J,"PSXDOD",2)
I $E(MSH,1,3)="MSH",$E(ARQ,1,3)="ARQ" I 1
E S PSXERR="1^ BAD SEGMENT SEQUENCE ^ Auto Scheduling Information ^ "_PATH_U_FNAME G ERRMSG
; variables are being set to call DOD^PSXMISC
F YY="SENDAPP^3","MSGTYPID^9","MSGID^10","HLDATETM^7" D PIECE(MSH,"|",YY)
I $E(IOST)="C" W !,"MSGTYPID ",MSGTYPID
S SITE="1"_$P(MSGID,"-") ;****Institution File
S XX=$O(^PSX(552,"D",SITE,0)),SITENM=$$GET1^DIQ(552,XX,.01)
S ARQ=$P(ARQ,"ARQ|",2)
F YY="STAT^6","DATE^11","HOUR^13","ROFF^15" D PIECE(ARQ,"|",YY)
S HOUR=$E(HOUR,2,99),HOUR=+HOUR,DATE=$$FMDATE^HLFNC(DATE)
I "SIU^S07,SIU^S20"'[MSGTYPID I $E(IOST)="C" W !,"STOPPING ",MSGTYPID Q ; Not a scheduling message.
S ROFF=$$FMNAME^HLFNC(ROFF,"^") ; remote official name
;S STDATE=$$FMDATE^HLFNC(DATE)
S:STAT=1 STAT=1,PSXCS=0
S:STAT=2 STAT=1,PSXCS=1
S:STAT=3 STAT=0,PSXCS=0
S:STAT=4 STAT=0,PSXCS=1
D DOD^PSXMISC
K ^TMP($J,"PSXDOD1")
D NOW^%DTC S DATETM=$$HLDATE^HLFNC(%),DATETM=+DATETM
S RESP=$S(MSGTYPID["SIU":"SRR^S07",1:"SRR^S20")
S MSH="MSH|^~\&|VistA||CHCS||2001121401100||SRR^SO7|10111-011214|P|2.3.1|NE|NE"
F YY="SENDAPP^5","MSGID^10","DATETM^7","RESP^9" D PUT(.MSH,"|",YY)
S ^TMP($J,"PSXDOD1",1)=MSH
S MSA="MSA|CA|"_MSGID_"|"
S ^TMP($J,"PSXDOD1",2)=MSA
S FNAME2=$P(FNAME1,"."),FNAME2=FNAME2_".HAC",PATH=$$GET1^DIQ(554,1,21)
F XX=1:1:5 S Y=$$GTF^%ZISH($NA(^TMP($J,"PSXDOD1",1)),3,PATH,FNAME2) Q:Y=1 H 4
I Y'=1 S GBL=$NA(^TMP($J,"PSXDOD")) D FALERT^PSXDODNT(FNAME2,PATH,GBL)
;I $E(IOST)="C" W !," FILING RESPONSE ",PATH," ",FNAME2," ",Y
S PATH=$$GET1^DIQ(554,1,22)
F XX=1:1:5 S Y=$$GTF^%ZISH($NA(^TMP($J,"PSXDOD1",1)),3,PATH,FNAME2) Q:Y=1 H 4
I Y'=1 S GBL=$NA(^TMP($J,"PSXDOD")) D FALERT^PSXDODNT(FNAME2,PATH,GBL)
Q
PIECE(REC,DLM,XX) ;
; Set variable V = piece P of REC using delimiter DLM
N V,P S V=$P(XX,U),P=$P(XX,U,2),@V=$P(REC,DLM,P)
Q
PUT(REC,DLM,XX) ;
; Set Variable V into piece P of REC using delimiter DLM
N V,P S V=$P(XX,U),P=$P(XX,U,2)
S $P(REC,DLM,P)=$G(@V)
Q
AUTO ; AUTO SCAN IN DIRECTORY AND FIRE UP JOBS
S PATH=$$GET1^DIQ(554,1,20)
Q:'$L(PATH)
K PSXF,PSXL
S PSXF("*.SCH")="",Y=$$LIST^%ZISH(PATH,"PSXF","PSXL")
I $E(IOST)="C" I 'Y W !,"NO FILES FOUND" Q
S FNAME="" F S FNAME=$O(PSXL(FNAME)) Q:FNAME="" D
. I $E(IOST)="C" W !," processing ",PATH," ",FNAME
. D EN(PATH,FNAME)
Q
ERRMSG ;
MSGSEQER ;send error message to folks & DOD
;W !,"error ",PSXERR
S XMSUB="DOD to CMOP Auto Scheduling Error"
;S XMY(DUZ)="" ;***TESTING
S XMY("G.CMOP MANAGERS")=""
S XMTEXT="PSXTXT("
S PSXTXT(1,0)="DOD to VA CMOP Auto Scheduling experienced an error"
S PSXTXT(2,0)=$G(PSXERR)
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXDODAT 3246 printed Oct 16, 2024@17:44:52 Page 2
PSXDODAT ;BRM/PDW-DOD PROCESS/FILE AUTO-SCHEDULING INFORMATION ;09/09/02 11:15 AM
+1 ;;2.0;CMOP;**38,45**;11 Apr 97
+2 QUIT
EN(PATH,FNAME) ; needs directory & file name
+1 IF $LENGTH(PATH)
IF $LENGTH(FNAME)
IF 1
+2 IF '$TEST
SET PSXERR="0^BAD PATH OR FILENAME"
GOTO ERRMSG
+3 KILL ^TMP($JOB,"PSXDOD")
+4 SET FNAME1=FNAME
+5 SET GBL="^TMP("_$JOB_",""PSXDOD"",1)"
+6 SET Y=$$FTG^%ZISH(PATH,FNAME,$NAME(^TMP($JOB,"PSXDOD",1)),3)
+7 IF Y'>0
SET PSXERR="9^"_PATH_U_FNAME_U_" DID NOT LOAD"
GOTO ERRMSG
+8 IF $DATA(^TMP($JOB,"PSXDOD"))'>1
SET PSXERR="9^"_PATH_U_FNAME_U_" DID NOT LOAD"
GOTO ERRMSG
EN1 ;
+1 KILL PSXERR
+2 SET (MSH,MSH1)=^TMP($JOB,"PSXDOD",1)
SET ARQ=^TMP($JOB,"PSXDOD",2)
+3 IF $EXTRACT(MSH,1,3)="MSH"
IF $EXTRACT(ARQ,1,3)="ARQ"
IF 1
+4 IF '$TEST
SET PSXERR="1^ BAD SEGMENT SEQUENCE ^ Auto Scheduling Information ^ "_PATH_U_FNAME
GOTO ERRMSG
+5 ; variables are being set to call DOD^PSXMISC
+6 FOR YY="SENDAPP^3","MSGTYPID^9","MSGID^10","HLDATETM^7"
DO PIECE(MSH,"|",YY)
+7 IF $EXTRACT(IOST)="C"
WRITE !,"MSGTYPID ",MSGTYPID
+8 ;****Institution File
SET SITE="1"_$PIECE(MSGID,"-")
+9 SET XX=$ORDER(^PSX(552,"D",SITE,0))
SET SITENM=$$GET1^DIQ(552,XX,.01)
+10 SET ARQ=$PIECE(ARQ,"ARQ|",2)
+11 FOR YY="STAT^6","DATE^11","HOUR^13","ROFF^15"
DO PIECE(ARQ,"|",YY)
+12 SET HOUR=$EXTRACT(HOUR,2,99)
SET HOUR=+HOUR
SET DATE=$$FMDATE^HLFNC(DATE)
+13 ; Not a scheduling message.
IF "SIU^S07,SIU^S20"'[MSGTYPID
IF $EXTRACT(IOST)="C"
WRITE !,"STOPPING ",MSGTYPID
QUIT
+14 ; remote official name
SET ROFF=$$FMNAME^HLFNC(ROFF,"^")
+15 ;S STDATE=$$FMDATE^HLFNC(DATE)
+16 if STAT=1
SET STAT=1
SET PSXCS=0
+17 if STAT=2
SET STAT=1
SET PSXCS=1
+18 if STAT=3
SET STAT=0
SET PSXCS=0
+19 if STAT=4
SET STAT=0
SET PSXCS=1
+20 DO DOD^PSXMISC
+21 KILL ^TMP($JOB,"PSXDOD1")
+22 DO NOW^%DTC
SET DATETM=$$HLDATE^HLFNC(%)
SET DATETM=+DATETM
+23 SET RESP=$SELECT(MSGTYPID["SIU":"SRR^S07",1:"SRR^S20")
+24 SET MSH="MSH|^~\&|VistA||CHCS||2001121401100||SRR^SO7|10111-011214|P|2.3.1|NE|NE"
+25 FOR YY="SENDAPP^5","MSGID^10","DATETM^7","RESP^9"
DO PUT(.MSH,"|",YY)
+26 SET ^TMP($JOB,"PSXDOD1",1)=MSH
+27 SET MSA="MSA|CA|"_MSGID_"|"
+28 SET ^TMP($JOB,"PSXDOD1",2)=MSA
+29 SET FNAME2=$PIECE(FNAME1,".")
SET FNAME2=FNAME2_".HAC"
SET PATH=$$GET1^DIQ(554,1,21)
+30 FOR XX=1:1:5
SET Y=$$GTF^%ZISH($NAME(^TMP($JOB,"PSXDOD1",1)),3,PATH,FNAME2)
if Y=1
QUIT
HANG 4
+31 IF Y'=1
SET GBL=$NAME(^TMP($JOB,"PSXDOD"))
DO FALERT^PSXDODNT(FNAME2,PATH,GBL)
+32 ;I $E(IOST)="C" W !," FILING RESPONSE ",PATH," ",FNAME2," ",Y
+33 SET PATH=$$GET1^DIQ(554,1,22)
+34 FOR XX=1:1:5
SET Y=$$GTF^%ZISH($NAME(^TMP($JOB,"PSXDOD1",1)),3,PATH,FNAME2)
if Y=1
QUIT
HANG 4
+35 IF Y'=1
SET GBL=$NAME(^TMP($JOB,"PSXDOD"))
DO FALERT^PSXDODNT(FNAME2,PATH,GBL)
+36 QUIT
PIECE(REC,DLM,XX) ;
+1 ; Set variable V = piece P of REC using delimiter DLM
+2 NEW V,P
SET V=$PIECE(XX,U)
SET P=$PIECE(XX,U,2)
SET @V=$PIECE(REC,DLM,P)
+3 QUIT
PUT(REC,DLM,XX) ;
+1 ; Set Variable V into piece P of REC using delimiter DLM
+2 NEW V,P
SET V=$PIECE(XX,U)
SET P=$PIECE(XX,U,2)
+3 SET $PIECE(REC,DLM,P)=$GET(@V)
+4 QUIT
AUTO ; AUTO SCAN IN DIRECTORY AND FIRE UP JOBS
+1 SET PATH=$$GET1^DIQ(554,1,20)
+2 if '$LENGTH(PATH)
QUIT
+3 KILL PSXF,PSXL
+4 SET PSXF("*.SCH")=""
SET Y=$$LIST^%ZISH(PATH,"PSXF","PSXL")
+5 IF $EXTRACT(IOST)="C"
IF 'Y
WRITE !,"NO FILES FOUND"
QUIT
+6 SET FNAME=""
FOR
SET FNAME=$ORDER(PSXL(FNAME))
if FNAME=""
QUIT
Begin DoDot:1
+7 IF $EXTRACT(IOST)="C"
WRITE !," processing ",PATH," ",FNAME
+8 DO EN(PATH,FNAME)
End DoDot:1
+9 QUIT
ERRMSG ;
MSGSEQER ;send error message to folks & DOD
+1 ;W !,"error ",PSXERR
+2 SET XMSUB="DOD to CMOP Auto Scheduling Error"
+3 ;S XMY(DUZ)="" ;***TESTING
+4 SET XMY("G.CMOP MANAGERS")=""
+5 SET XMTEXT="PSXTXT("
+6 SET PSXTXT(1,0)="DOD to VA CMOP Auto Scheduling experienced an error"
+7 SET PSXTXT(2,0)=$GET(PSXERR)
+8 DO ^XMD
+9 QUIT
