- 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 Jan 18, 2025@02:45:13 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