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