PSXDODAC ;BIR/WPB,HTW - DoD Medical Center Activation Routine ;09/09/02 4:00 PM
;;2.0;CMOP;**38,45**;11 Apr 97
;Reference to ^DIC(4.2 supported by DBIA #1966
;This routine reads in the DoD activation request from the file and
;formats the data in the same format as the medical center activation
;request and calls the VA activation routines for processing
;MSH|^~\&|CHCS||VistA||20020103112600||MFN^M01|0124-020031126|P|2.3.1|||AL|AL
;MFE|MUP|0124_020031126|20011227153000|0124|CE
;ZLF|1|^BUCHANAN^STEVE||
ACT(PATH,FILENM) ; This entry point is called by DIRECT+1^PSXDODNT
K ^TMP($J,"PSXACT")
S OK=0,J=$P(FILENM,"."),SITEID=$P(J,"_"),TRAN=$TR(J,"_","-")
S GBL="^TMP("_$J_",""PSXACT"",1)"
S Y=$$FTG^%ZISH(PATH,FILENM,GBL,3)
I $G(Y)'=1 S ERRTXT(2)="Failure reading file: "_FILENM,ERRTXT(3)="Error occurred at ACT+5^PSXDODAC" G MSG
S NODE1=$G(^TMP($J,"PSXACT",1)) S:$P(NODE1,"|")'="MSH" OK=1 S:$P(NODE1,"|",10)'=TRAN OK=2
S NODE2=$G(^TMP($J,"PSXACT",2)) S:$P(NODE2,"|")'="MFE" OK=1 S:$P(NODE2,"|",3)'=TRAN OK=2
S NODE3=$G(^TMP($J,"PSXACT",3)) S:$P(NODE3,"|")'="ZLF" OK=1
K TRAN
I $G(OK)>0 G ERROR
;if No errors found then parse the data from the segments and file the request in the CMOP National file and
;send the action alert to holders of the PSXCMOPMGR key
D NOW^%DTC S (RDTTM,RTDTM,Y)=% X ^DD("DD") S RDTM=Y K Y,%
S (X,RDOM)=^XMB("NETNAME"),DIC="^DIC(4.2,",DIC(0)="BXZ" D ^DIC
K DIC I $D(DUOUT)!($D(DTOUT))!(X["^") G EXIT
S SITENUM=$$IEN^XUMF(4,"DMIS",SITEID),SITEN=$$GET1^DIQ(4,SITENUM,.01) K DIC,X,Y
;Until the CMOP files are modified to allow strings the number 1 is used as a prefix
;on the DMIS ID which can have leading zero's
S TYPE=$P(NODE3,"|",2),X=$P(NODE3,"|",3),AGENCY=1_$P(NODE2,"|",5)
S HLECDE="^",REQT=$$FMNAME^HLFNC(X,HLECDE) K X
S NAME=$$GET1^DIQ(200,DUZ,.01)
S CMOP="Leavenworth",OLD="9999999"
I $G(TYPE)=5!($G(TYPE)=6) S ACTFLAG=0 D FILE^PSXSITE,DEACT G EXIT
S ACTFLAG=1 D FILE^PSXSITE S MFLAG=0
S XQSOP="XXXX",XQMSG="ZZZZZ" ; place holders...not used for DOD
S XQADATA=SITEN_"^"_$G(RDOM)_"^"_CMOP_"^"_REQT_"^"_FILENM_"^"_RTDTM_"^"_SITENUM_"^"_XQSOP_"^"_XQMSG_"^"_NAME_"^"_J,XQAMSG=SITEN_" has submitted a request to activate CMOP processing.",XQAROU="ORK^PSXDODAC",XQAID="PSXDODAC"
D GRP1^PSXNOTE M XQA=XMY D SETUP^XQALERT
EXIT ;
Q
K Y,OK,XQADATA,SITEN,RDOM,CMOP,REQT,RTDTM,SITENUM,XQSOP,XQMSG,SITEN,NAME,XQAMSG,SITEN
K XQAROU,XQAID,RDTM
Q
ORK ; Entry point for activation alert processing
S SITE=$P(XQADATA,U,1),CMOP=$P(XQADATA,U,3),(REQ,REQT)=$P(XQADATA,U,4),FILENM=$P(XQADATA,U,5)
S RDTTM=$P(XQADATA,U,6),SITENUM=$P(XQADATA,U,7),RDOM=$P(XQADATA,U,2),XMSER="S."_$P(XQADATA,U,8)
S TXMZ=$P(XQADATA,U,9),NAME=$P(XQADATA,U,10),J=$P(XQADATA,U,11)
S DIR(0)="SO^A:APPROVED;D:DISAPPROVED",DIR("A",1)=SITE_" has submitted a request to activate CMOP processing.",DIR("A",2)="",DIR("A")="Select"
D ^DIR K DIR S (ACTION,STAT)=Y G:($D(DIRUT)) EXIT K Y
WK I ACTION="A" S ACTFLAG=1
I ACTION="D" S ACTFLAG=0
OK S %H=$H D YX^%DTC S DTE=Y K Y
S ANSWER=($S(ACTION="A":"CMOP Activation Approval",ACTION="D":"CMOP Activation Disapproved",1:"")),LCNT=2
S XQAKILL=0 D DELETE^XQALERT
;File appr/disappr in 552
FILEA S REC=$O(^PSX(552,"B",SITENUM,"")) Q:REC=""
L +^PSX(552,REC):600 G:'$T FILEA S DA=REC,DIE="^PSX(552,",DR="2////"_$S(ACTFLAG=1:"A",ACTFLAG=0:"I",1:0) D ^DIE K DIE,DA,DR
S XSS=0 F S XSS=$O(^PSX(552,REC,1,XSS)) Q:XSS'>0 S SUBREC=XSS
D NOW^%DTC S OKTIME=$$FMTHL7^XLFDT(%),OKTIME=$P(OKTIME,"-")
S DA(1)=REC,DA=SUBREC,DIE="^PSX(552,"_REC_",1,",DR="3////"_%_";4////"_DUZ_";7////"_ACTION D ^DIE L -^PSX(552,REC) K DIE,DA,SUBREC,REC,STAT,%,XSS
REPLY ;Make activation reply file
S NAME=$$GET1^DIQ(200,DUZ,.01),HLECDE=",",REQT=$$FMNAME^HLFNC(NAME,HLECDE) K X
S FILE=J_".SAC",J=$TR(J,"_","-")
;MFR^M01-ACTIVATION,MFR^M02 - Deactivation
S MSH="MSH|^~\&|VistA||CHCS||"_OKTIME_"||MFR^M01|"_J_"|P|2.3.1|||NE|NE"
S MFE="MFE|MUP|"_J_"|"_OKTIME_"|"_$P(J,"-")_"|CE"
I ACTFLAG="DEACTIVATION" S ZLF="ZLF|"_TYPE_"|CMOP-"_$$GET1^DIQ(554,1,.01) I 1 ; set ACK FOR deactivation request
E S ZLF="ZLF|"_$S(ACTFLAG=0:4,ACTFLAG=1:3,1:"")_"|"_NAME
K ^XTMP("PSXAK"_J) S PATH=$$GET1^DIQ(554,1,21)
S A="PSXAK"_J
S X=$$FMADD^XLFDT(DT,+2) S ^XTMP(A,0)=X_U_DT_U_"CMOP ACTIVATION RESPONSE" K X
S ^XTMP(A,J,1)=$G(MSH)
S ^XTMP(A,J,2)=$G(MFE)
S ^XTMP(A,J,3)=$G(ZLF)
F XX=1:1:5 S Y=$$GTF^%ZISH($NA(^XTMP(A,J,1)),3,PATH,FILE) Q:Y=1 H 4
I Y'=1 S GBL=$NA(^XTMP(A,J)) D FALERT^PSXDODNT(FILE,PATH,GBL)
S PATH=$$GET1^DIQ(554,1,22)
F XX=1:1:5 S Y=$$GTF^%ZISH($NA(^XTMP(A,J,1)),3,PATH,FILE) Q:Y=1 H 4
I Y'=1 S GBL=$NA(^XTMP(A,J)) D FALERT^PSXDODNT(FILE,PATH,GBL)
I $G(Y)'=1 S ERRTXT(2)="Failure writing to file: "_FILE,ERRTXT(3)="Error occurred at REPLY+10^PSXDODAC" G MSG^PSXDODAC
K FILE,Y,MSH,MFE,ZLF,PATCH,A,ACTFLAG,NAME,OKTIME,XSS,SUBREC,LCNT,ANSWER,ACTION,J,FILE
Q
ERROR ;sends the error message back to the sending station
;parse the data from the msh segment in order to send back the error message
;OK equals 1 - segments not in the correct order
;OK equals 2 - segments not assigned to the open file or segments don't match
;OK equals 3 - site and file don't match
D NOW^%DTC S USER=$TR($P(^VA(200,DUZ,0),"^",1),",","^")
S REJ=$S(OK=1:"SEGMENTS OUT OF SEQUENCE",OK=2:"SEGMENTS AND FILE MIS-MATCH",OK=3:"SITE NUMBER AND FILE NAME MIS-MATCH",1:"")
S PATH=$$GET1^DIQ(554,1,21)
;S PATH=$P($G(^PSX(554,1,"DOD")),"^")
S ACKDATE=$P($$FMTHL7^XLFDT(%),"-",1)
S ^TMP($J,"ACTREPLY",1)="MSH|^~\&|VistA||CHCS||"_$G(ACKDATE)_"||MFR^M01|"_$G(J)_"|P|2.3.1|||NE|NE"
S ^TMP($J,"ACTREPLY",2)="MFE|MUP|"_$G(J)_"|"_$G(ACKDATE)_"|"_$G(SITE)_"|CE"
S ^TMP($J,"ACTREPLY",3)="ZLF|4|^"_$G(USER)_"||"_$G(REJ)
S FILEN=$G(J)_".SAC"
S Y=$$GTF^%ZISH($NA(^TMP($J,"ACTREPLY",1)),2,PATH,FILEN)
I $G(Y)'=1 S ERRTXT(2)="Failure writing file: "_FILEN,ERRTXT(3)="Error occurred at ERROR+15^PSXDODAC" G MSG
K:Y=1 %,ACKDATE,USER,SITE,^TMP($J,"ACTREPLY"),FILEN,Y,REJ,OK
Q
MSG ;send error message
S XMSUB="DoD CMOP Activation Error",ERRTXT(1)="This error indicates a problem reading or writing to a host file"
MM1 S XMDUZ=.5
S XMTEXT="ERRTXT("
D GRP1^PSXNOTE
D ^XMD
Q
DEACT ;Conjure Deactivation Msg
S XMDUZ=.5,XMSUB="CMOP Inactivation Notice, "_SITEN,LCNT=5
D XMZ^XMA2 G:XMZ<1 DEACT
S ^XMB(3.9,XMZ,2,1,0)="Notice to Inactivate CMOP Processing."
S ^XMB(3.9,XMZ,2,2,0)=""
S ^XMB(3.9,XMZ,2,3,0)="Facility : "_SITEN
S ^XMB(3.9,XMZ,2,4,0)="Notifying Official : "_REQT
S ^XMB(3.9,XMZ,2,5,0)="Notification date/time : "_$P(RDTM,":",1,2)
S ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_"^"_LCNT_"^"_DT,XMDUN=NAME
K XMY S XMDUZ=.5 D GRP^PSXNOTE
D ENT1^XMD
D NOW^%DTC S OKTIME=$$FMTHL7^XLFDT(%),OKTIME=$P(OKTIME,"-")
S FILE=J_".SAC",J=$TR(J,"_","-"),PATH=$$GET1^DIQ(554,1,21)
S MSH="MSH|^~\&|VistA||CHCS||"_OKTIME_"||MFR^M02|"_J_"|P|2.3.1|||NE|NE"
S MSA="MSA|CA|"_J_"|"
K ^TMP($J,"PSXDODAC")
S ^TMP($J,"PSXDODAC",1)=MSH
S ^TMP($J,"PSXDODAC",2)=MSA
F XX=1:1:5 S Y=$$GTF^%ZISH($NA(^TMP($J,"PSXDODAC",1)),3,PATH,FILE) Q:Y=1 H 4
I Y'=1 S GBL=$NA(^TMP($J,"PSXDODAC")) D FALERT^PSXDODNT(FILE,PATH,GBL)
S PATH=$$GET1^DIQ(554,1,22)
F XX=1:1:5 S Y=$$GTF^%ZISH($NA(^TMP($J,"PSXDODAC",1)),3,PATH,FILE) Q:Y=1 H 4
I Y'=1 S GBL=$NA(^TMP($J,"PSXDODAC")) D FALERT^PSXDODNT(FILE,PATH,GBL)
I $G(Y)'=1 S ERRTXT(2)="Failure writing to file: "_FILE,ERRTXT(3)="Error occurred at REPLY+10^PSXDODAC" G MSG^PSXDODAC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXDODAC 7485 printed Apr 09, 2024@20:48:43 Page 2
PSXDODAC ;BIR/WPB,HTW - DoD Medical Center Activation Routine ;09/09/02 4:00 PM
+1 ;;2.0;CMOP;**38,45**;11 Apr 97
+2 ;Reference to ^DIC(4.2 supported by DBIA #1966
+3 ;This routine reads in the DoD activation request from the file and
+4 ;formats the data in the same format as the medical center activation
+5 ;request and calls the VA activation routines for processing
+6 ;MSH|^~\&|CHCS||VistA||20020103112600||MFN^M01|0124-020031126|P|2.3.1|||AL|AL
+7 ;MFE|MUP|0124_020031126|20011227153000|0124|CE
+8 ;ZLF|1|^BUCHANAN^STEVE||
ACT(PATH,FILENM) ; This entry point is called by DIRECT+1^PSXDODNT
+1 KILL ^TMP($JOB,"PSXACT")
+2 SET OK=0
SET J=$PIECE(FILENM,".")
SET SITEID=$PIECE(J,"_")
SET TRAN=$TRANSLATE(J,"_","-")
+3 SET GBL="^TMP("_$JOB_",""PSXACT"",1)"
+4 SET Y=$$FTG^%ZISH(PATH,FILENM,GBL,3)
+5 IF $GET(Y)'=1
SET ERRTXT(2)="Failure reading file: "_FILENM
SET ERRTXT(3)="Error occurred at ACT+5^PSXDODAC"
GOTO MSG
+6 SET NODE1=$GET(^TMP($JOB,"PSXACT",1))
if $PIECE(NODE1,"|")'="MSH"
SET OK=1
if $PIECE(NODE1,"|",10)'=TRAN
SET OK=2
+7 SET NODE2=$GET(^TMP($JOB,"PSXACT",2))
if $PIECE(NODE2,"|")'="MFE"
SET OK=1
if $PIECE(NODE2,"|",3)'=TRAN
SET OK=2
+8 SET NODE3=$GET(^TMP($JOB,"PSXACT",3))
if $PIECE(NODE3,"|")'="ZLF"
SET OK=1
+9 KILL TRAN
+10 IF $GET(OK)>0
GOTO ERROR
+11 ;if No errors found then parse the data from the segments and file the request in the CMOP National file and
+12 ;send the action alert to holders of the PSXCMOPMGR key
+13 DO NOW^%DTC
SET (RDTTM,RTDTM,Y)=%
XECUTE ^DD("DD")
SET RDTM=Y
KILL Y,%
+14 SET (X,RDOM)=^XMB("NETNAME")
SET DIC="^DIC(4.2,"
SET DIC(0)="BXZ"
DO ^DIC
+15 KILL DIC
IF $DATA(DUOUT)!($DATA(DTOUT))!(X["^")
GOTO EXIT
+16 SET SITENUM=$$IEN^XUMF(4,"DMIS",SITEID)
SET SITEN=$$GET1^DIQ(4,SITENUM,.01)
KILL DIC,X,Y
+17 ;Until the CMOP files are modified to allow strings the number 1 is used as a prefix
+18 ;on the DMIS ID which can have leading zero's
+19 SET TYPE=$PIECE(NODE3,"|",2)
SET X=$PIECE(NODE3,"|",3)
SET AGENCY=1_$PIECE(NODE2,"|",5)
+20 SET HLECDE="^"
SET REQT=$$FMNAME^HLFNC(X,HLECDE)
KILL X
+21 SET NAME=$$GET1^DIQ(200,DUZ,.01)
+22 SET CMOP="Leavenworth"
SET OLD="9999999"
+23 IF $GET(TYPE)=5!($GET(TYPE)=6)
SET ACTFLAG=0
DO FILE^PSXSITE
DO DEACT
GOTO EXIT
+24 SET ACTFLAG=1
DO FILE^PSXSITE
SET MFLAG=0
+25 ; place holders...not used for DOD
SET XQSOP="XXXX"
SET XQMSG="ZZZZZ"
+26 SET XQADATA=SITEN_"^"_$GET(RDOM)_"^"_CMOP_"^"_REQT_"^"_FILENM_"^"_RTDTM_"^"_SITENUM_"^"_XQSOP_"^"_XQMSG_"^"_NAME_"^"_J
SET XQAMSG=SITEN_" has submitted a request to activate CMOP processing."
SET XQAROU="ORK^PSXDODAC"
SET XQAID="PSXDODAC"
+27 DO GRP1^PSXNOTE
MERGE XQA=XMY
DO SETUP^XQALERT
EXIT ;
+1 QUIT
+2 KILL Y,OK,XQADATA,SITEN,RDOM,CMOP,REQT,RTDTM,SITENUM,XQSOP,XQMSG,SITEN,NAME,XQAMSG,SITEN
+3 KILL XQAROU,XQAID,RDTM
+4 QUIT
ORK ; Entry point for activation alert processing
+1 SET SITE=$PIECE(XQADATA,U,1)
SET CMOP=$PIECE(XQADATA,U,3)
SET (REQ,REQT)=$PIECE(XQADATA,U,4)
SET FILENM=$PIECE(XQADATA,U,5)
+2 SET RDTTM=$PIECE(XQADATA,U,6)
SET SITENUM=$PIECE(XQADATA,U,7)
SET RDOM=$PIECE(XQADATA,U,2)
SET XMSER="S."_$PIECE(XQADATA,U,8)
+3 SET TXMZ=$PIECE(XQADATA,U,9)
SET NAME=$PIECE(XQADATA,U,10)
SET J=$PIECE(XQADATA,U,11)
+4 SET DIR(0)="SO^A:APPROVED;D:DISAPPROVED"
SET DIR("A",1)=SITE_" has submitted a request to activate CMOP processing."
SET DIR("A",2)=""
SET DIR("A")="Select"
+5 DO ^DIR
KILL DIR
SET (ACTION,STAT)=Y
if ($DATA(DIRUT))
GOTO EXIT
KILL Y
WK IF ACTION="A"
SET ACTFLAG=1
+1 IF ACTION="D"
SET ACTFLAG=0
OK SET %H=$HOROLOG
DO YX^%DTC
SET DTE=Y
KILL Y
+1 SET ANSWER=($SELECT(ACTION="A":"CMOP Activation Approval",ACTION="D":"CMOP Activation Disapproved",1:""))
SET LCNT=2
+2 SET XQAKILL=0
DO DELETE^XQALERT
+3 ;File appr/disappr in 552
FILEA SET REC=$ORDER(^PSX(552,"B",SITENUM,""))
if REC=""
QUIT
+1 LOCK +^PSX(552,REC):600
if '$TEST
GOTO FILEA
SET DA=REC
SET DIE="^PSX(552,"
SET DR="2////"_$SELECT(ACTFLAG=1:"A",ACTFLAG=0:"I",1:0)
DO ^DIE
KILL DIE,DA,DR
+2 SET XSS=0
FOR
SET XSS=$ORDER(^PSX(552,REC,1,XSS))
if XSS'>0
QUIT
SET SUBREC=XSS
+3 DO NOW^%DTC
SET OKTIME=$$FMTHL7^XLFDT(%)
SET OKTIME=$PIECE(OKTIME,"-")
+4 SET DA(1)=REC
SET DA=SUBREC
SET DIE="^PSX(552,"_REC_",1,"
SET DR="3////"_%_";4////"_DUZ_";7////"_ACTION
DO ^DIE
LOCK -^PSX(552,REC)
KILL DIE,DA,SUBREC,REC,STAT,%,XSS
REPLY ;Make activation reply file
+1 SET NAME=$$GET1^DIQ(200,DUZ,.01)
SET HLECDE=","
SET REQT=$$FMNAME^HLFNC(NAME,HLECDE)
KILL X
+2 SET FILE=J_".SAC"
SET J=$TRANSLATE(J,"_","-")
+3 ;MFR^M01-ACTIVATION,MFR^M02 - Deactivation
+4 SET MSH="MSH|^~\&|VistA||CHCS||"_OKTIME_"||MFR^M01|"_J_"|P|2.3.1|||NE|NE"
+5 SET MFE="MFE|MUP|"_J_"|"_OKTIME_"|"_$PIECE(J,"-")_"|CE"
+6 ; set ACK FOR deactivation request
IF ACTFLAG="DEACTIVATION"
SET ZLF="ZLF|"_TYPE_"|CMOP-"_$$GET1^DIQ(554,1,.01)
IF 1
+7 IF '$TEST
SET ZLF="ZLF|"_$SELECT(ACTFLAG=0:4,ACTFLAG=1:3,1:"")_"|"_NAME
+8 KILL ^XTMP("PSXAK"_J)
SET PATH=$$GET1^DIQ(554,1,21)
+9 SET A="PSXAK"_J
+10 SET X=$$FMADD^XLFDT(DT,+2)
SET ^XTMP(A,0)=X_U_DT_U_"CMOP ACTIVATION RESPONSE"
KILL X
+11 SET ^XTMP(A,J,1)=$GET(MSH)
+12 SET ^XTMP(A,J,2)=$GET(MFE)
+13 SET ^XTMP(A,J,3)=$GET(ZLF)
+14 FOR XX=1:1:5
SET Y=$$GTF^%ZISH($NAME(^XTMP(A,J,1)),3,PATH,FILE)
if Y=1
QUIT
HANG 4
+15 IF Y'=1
SET GBL=$NAME(^XTMP(A,J))
DO FALERT^PSXDODNT(FILE,PATH,GBL)
+16 SET PATH=$$GET1^DIQ(554,1,22)
+17 FOR XX=1:1:5
SET Y=$$GTF^%ZISH($NAME(^XTMP(A,J,1)),3,PATH,FILE)
if Y=1
QUIT
HANG 4
+18 IF Y'=1
SET GBL=$NAME(^XTMP(A,J))
DO FALERT^PSXDODNT(FILE,PATH,GBL)
+19 IF $GET(Y)'=1
SET ERRTXT(2)="Failure writing to file: "_FILE
SET ERRTXT(3)="Error occurred at REPLY+10^PSXDODAC"
GOTO MSG^PSXDODAC
+20 KILL FILE,Y,MSH,MFE,ZLF,PATCH,A,ACTFLAG,NAME,OKTIME,XSS,SUBREC,LCNT,ANSWER,ACTION,J,FILE
+21 QUIT
ERROR ;sends the error message back to the sending station
+1 ;parse the data from the msh segment in order to send back the error message
+2 ;OK equals 1 - segments not in the correct order
+3 ;OK equals 2 - segments not assigned to the open file or segments don't match
+4 ;OK equals 3 - site and file don't match
+5 DO NOW^%DTC
SET USER=$TRANSLATE($PIECE(^VA(200,DUZ,0),"^",1),",","^")
+6 SET REJ=$SELECT(OK=1:"SEGMENTS OUT OF SEQUENCE",OK=2:"SEGMENTS AND FILE MIS-MATCH",OK=3:"SITE NUMBER AND FILE NAME MIS-MATCH",1:"")
+7 SET PATH=$$GET1^DIQ(554,1,21)
+8 ;S PATH=$P($G(^PSX(554,1,"DOD")),"^")
+9 SET ACKDATE=$PIECE($$FMTHL7^XLFDT(%),"-",1)
+10 SET ^TMP($JOB,"ACTREPLY",1)="MSH|^~\&|VistA||CHCS||"_$GET(ACKDATE)_"||MFR^M01|"_$GET(J)_"|P|2.3.1|||NE|NE"
+11 SET ^TMP($JOB,"ACTREPLY",2)="MFE|MUP|"_$GET(J)_"|"_$GET(ACKDATE)_"|"_$GET(SITE)_"|CE"
+12 SET ^TMP($JOB,"ACTREPLY",3)="ZLF|4|^"_$GET(USER)_"||"_$GET(REJ)
+13 SET FILEN=$GET(J)_".SAC"
+14 SET Y=$$GTF^%ZISH($NAME(^TMP($JOB,"ACTREPLY",1)),2,PATH,FILEN)
+15 IF $GET(Y)'=1
SET ERRTXT(2)="Failure writing file: "_FILEN
SET ERRTXT(3)="Error occurred at ERROR+15^PSXDODAC"
GOTO MSG
+16 if Y=1
KILL %,ACKDATE,USER,SITE,^TMP($JOB,"ACTREPLY"),FILEN,Y,REJ,OK
+17 QUIT
MSG ;send error message
+1 SET XMSUB="DoD CMOP Activation Error"
SET ERRTXT(1)="This error indicates a problem reading or writing to a host file"
MM1 SET XMDUZ=.5
+1 SET XMTEXT="ERRTXT("
+2 DO GRP1^PSXNOTE
+3 DO ^XMD
+4 QUIT
DEACT ;Conjure Deactivation Msg
+1 SET XMDUZ=.5
SET XMSUB="CMOP Inactivation Notice, "_SITEN
SET LCNT=5
+2 DO XMZ^XMA2
if XMZ<1
GOTO DEACT
+3 SET ^XMB(3.9,XMZ,2,1,0)="Notice to Inactivate CMOP Processing."
+4 SET ^XMB(3.9,XMZ,2,2,0)=""
+5 SET ^XMB(3.9,XMZ,2,3,0)="Facility : "_SITEN
+6 SET ^XMB(3.9,XMZ,2,4,0)="Notifying Official : "_REQT
+7 SET ^XMB(3.9,XMZ,2,5,0)="Notification date/time : "_$PIECE(RDTM,":",1,2)
+8 SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_"^"_LCNT_"^"_DT
SET XMDUN=NAME
+9 KILL XMY
SET XMDUZ=.5
DO GRP^PSXNOTE
+10 DO ENT1^XMD
+11 DO NOW^%DTC
SET OKTIME=$$FMTHL7^XLFDT(%)
SET OKTIME=$PIECE(OKTIME,"-")
+12 SET FILE=J_".SAC"
SET J=$TRANSLATE(J,"_","-")
SET PATH=$$GET1^DIQ(554,1,21)
+13 SET MSH="MSH|^~\&|VistA||CHCS||"_OKTIME_"||MFR^M02|"_J_"|P|2.3.1|||NE|NE"
+14 SET MSA="MSA|CA|"_J_"|"
+15 KILL ^TMP($JOB,"PSXDODAC")
+16 SET ^TMP($JOB,"PSXDODAC",1)=MSH
+17 SET ^TMP($JOB,"PSXDODAC",2)=MSA
+18 FOR XX=1:1:5
SET Y=$$GTF^%ZISH($NAME(^TMP($JOB,"PSXDODAC",1)),3,PATH,FILE)
if Y=1
QUIT
HANG 4
+19 IF Y'=1
SET GBL=$NAME(^TMP($JOB,"PSXDODAC"))
DO FALERT^PSXDODNT(FILE,PATH,GBL)
+20 SET PATH=$$GET1^DIQ(554,1,22)
+21 FOR XX=1:1:5
SET Y=$$GTF^%ZISH($NAME(^TMP($JOB,"PSXDODAC",1)),3,PATH,FILE)
if Y=1
QUIT
HANG 4
+22 IF Y'=1
SET GBL=$NAME(^TMP($JOB,"PSXDODAC"))
DO FALERT^PSXDODNT(FILE,PATH,GBL)
+23 IF $GET(Y)'=1
SET ERRTXT(2)="Failure writing to file: "_FILE
SET ERRTXT(3)="Error occurred at REPLY+10^PSXDODAC"
GOTO MSG^PSXDODAC
+24 QUIT
