PSXDODAT.m

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 ---PSXDODAT   3246     printed  Mar 13, 2025@20:48:40                                                                                                                                                                                                    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