source: FOIAVistA/tag/r/CMOP-PSX/PSXDODAC.m@ 1700

Last change on this file since 1700 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.2 KB
Line 
1PSXDODAC ;BIR/WPB,HTW - DoD Medical Center Activation Routine ;09/09/02 4:00 PM
2 ;;2.0;CMOP;**38,45**;11 Apr 97
3 ;Reference to ^DIC(4.2 supported by DBIA #1966
4 ;This routine reads in the DoD activation request from the file and
5 ;formats the data in the same format as the medical center activation
6 ;request and calls the VA activation routines for processing
7 ;MSH|^~\&|CHCS||VistA||20020103112600||MFN^M01|0124-020031126|P|2.3.1|||AL|AL
8 ;MFE|MUP|0124_020031126|20011227153000|0124|CE
9 ;ZLF|1|^BUCHANAN^STEVE||
10ACT(PATH,FILENM) ; This entry point is called by DIRECT+1^PSXDODNT
11 K ^TMP($J,"PSXACT")
12 S OK=0,J=$P(FILENM,"."),SITEID=$P(J,"_"),TRAN=$TR(J,"_","-")
13 S GBL="^TMP("_$J_",""PSXACT"",1)"
14 S Y=$$FTG^%ZISH(PATH,FILENM,GBL,3)
15 I $G(Y)'=1 S ERRTXT(2)="Failure reading file: "_FILENM,ERRTXT(3)="Error occurred at ACT+5^PSXDODAC" G MSG
16 S NODE1=$G(^TMP($J,"PSXACT",1)) S:$P(NODE1,"|")'="MSH" OK=1 S:$P(NODE1,"|",10)'=TRAN OK=2
17 S NODE2=$G(^TMP($J,"PSXACT",2)) S:$P(NODE2,"|")'="MFE" OK=1 S:$P(NODE2,"|",3)'=TRAN OK=2
18 S NODE3=$G(^TMP($J,"PSXACT",3)) S:$P(NODE3,"|")'="ZLF" OK=1
19 K TRAN
20 I $G(OK)>0 G ERROR
21 ;if No errors found then parse the data from the segments and file the request in the CMOP National file and
22 ;send the action alert to holders of the PSXCMOPMGR key
23 D NOW^%DTC S (RDTTM,RTDTM,Y)=% X ^DD("DD") S RDTM=Y K Y,%
24 S (X,RDOM)=^XMB("NETNAME"),DIC="^DIC(4.2,",DIC(0)="BXZ" D ^DIC
25 K DIC I $D(DUOUT)!($D(DTOUT))!(X["^") G EXIT
26 S SITENUM=$$IEN^XUMF(4,"DMIS",SITEID),SITEN=$$GET1^DIQ(4,SITENUM,.01) K DIC,X,Y
27 ;Until the CMOP files are modified to allow strings the number 1 is used as a prefix
28 ;on the DMIS ID which can have leading zero's
29 S TYPE=$P(NODE3,"|",2),X=$P(NODE3,"|",3),AGENCY=1_$P(NODE2,"|",5)
30 S HLECDE="^",REQT=$$FMNAME^HLFNC(X,HLECDE) K X
31 S NAME=$$GET1^DIQ(200,DUZ,.01)
32 S CMOP="Leavenworth",OLD="9999999"
33 I $G(TYPE)=5!($G(TYPE)=6) S ACTFLAG=0 D FILE^PSXSITE,DEACT G EXIT
34 S ACTFLAG=1 D FILE^PSXSITE S MFLAG=0
35 S XQSOP="XXXX",XQMSG="ZZZZZ" ; place holders...not used for DOD
36 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"
37 D GRP1^PSXNOTE M XQA=XMY D SETUP^XQALERT
38EXIT ;
39 Q
40 K Y,OK,XQADATA,SITEN,RDOM,CMOP,REQT,RTDTM,SITENUM,XQSOP,XQMSG,SITEN,NAME,XQAMSG,SITEN
41 K XQAROU,XQAID,RDTM
42 Q
43ORK ; Entry point for activation alert processing
44 S SITE=$P(XQADATA,U,1),CMOP=$P(XQADATA,U,3),(REQ,REQT)=$P(XQADATA,U,4),FILENM=$P(XQADATA,U,5)
45 S RDTTM=$P(XQADATA,U,6),SITENUM=$P(XQADATA,U,7),RDOM=$P(XQADATA,U,2),XMSER="S."_$P(XQADATA,U,8)
46 S TXMZ=$P(XQADATA,U,9),NAME=$P(XQADATA,U,10),J=$P(XQADATA,U,11)
47 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"
48 D ^DIR K DIR S (ACTION,STAT)=Y G:($D(DIRUT)) EXIT K Y
49WK I ACTION="A" S ACTFLAG=1
50 I ACTION="D" S ACTFLAG=0
51OK S %H=$H D YX^%DTC S DTE=Y K Y
52 S ANSWER=($S(ACTION="A":"CMOP Activation Approval",ACTION="D":"CMOP Activation Disapproved",1:"")),LCNT=2
53 S XQAKILL=0 D DELETE^XQALERT
54 ;File appr/disappr in 552
55FILEA S REC=$O(^PSX(552,"B",SITENUM,"")) Q:REC=""
56 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
57 S XSS=0 F S XSS=$O(^PSX(552,REC,1,XSS)) Q:XSS'>0 S SUBREC=XSS
58 D NOW^%DTC S OKTIME=$$FMTHL7^XLFDT(%),OKTIME=$P(OKTIME,"-")
59 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
60REPLY ;Make activation reply file
61 S NAME=$$GET1^DIQ(200,DUZ,.01),HLECDE=",",REQT=$$FMNAME^HLFNC(NAME,HLECDE) K X
62 S FILE=J_".SAC",J=$TR(J,"_","-")
63 ;MFR^M01-ACTIVATION,MFR^M02 - Deactivation
64 S MSH="MSH|^~\&|VistA||CHCS||"_OKTIME_"||MFR^M01|"_J_"|P|2.3.1|||NE|NE"
65 S MFE="MFE|MUP|"_J_"|"_OKTIME_"|"_$P(J,"-")_"|CE"
66 I ACTFLAG="DEACTIVATION" S ZLF="ZLF|"_TYPE_"|CMOP-"_$$GET1^DIQ(554,1,.01) I 1 ; set ACK FOR deactivation request
67 E S ZLF="ZLF|"_$S(ACTFLAG=0:4,ACTFLAG=1:3,1:"")_"|"_NAME
68 K ^XTMP("PSXAK"_J) S PATH=$$GET1^DIQ(554,1,21)
69 S A="PSXAK"_J
70 S X=$$FMADD^XLFDT(DT,+2) S ^XTMP(A,0)=X_U_DT_U_"CMOP ACTIVATION RESPONSE" K X
71 S ^XTMP(A,J,1)=$G(MSH)
72 S ^XTMP(A,J,2)=$G(MFE)
73 S ^XTMP(A,J,3)=$G(ZLF)
74 F XX=1:1:5 S Y=$$GTF^%ZISH($NA(^XTMP(A,J,1)),3,PATH,FILE) Q:Y=1 H 4
75 I Y'=1 S GBL=$NA(^XTMP(A,J)) D FALERT^PSXDODNT(FILE,PATH,GBL)
76 S PATH=$$GET1^DIQ(554,1,22)
77 F XX=1:1:5 S Y=$$GTF^%ZISH($NA(^XTMP(A,J,1)),3,PATH,FILE) Q:Y=1 H 4
78 I Y'=1 S GBL=$NA(^XTMP(A,J)) D FALERT^PSXDODNT(FILE,PATH,GBL)
79 I $G(Y)'=1 S ERRTXT(2)="Failure writing to file: "_FILE,ERRTXT(3)="Error occurred at REPLY+10^PSXDODAC" G MSG^PSXDODAC
80 K FILE,Y,MSH,MFE,ZLF,PATCH,A,ACTFLAG,NAME,OKTIME,XSS,SUBREC,LCNT,ANSWER,ACTION,J,FILE
81 Q
82ERROR ;sends the error message back to the sending station
83 ;parse the data from the msh segment in order to send back the error message
84 ;OK equals 1 - segments not in the correct order
85 ;OK equals 2 - segments not assigned to the open file or segments don't match
86 ;OK equals 3 - site and file don't match
87 D NOW^%DTC S USER=$TR($P(^VA(200,DUZ,0),"^",1),",","^")
88 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:"")
89 S PATH=$$GET1^DIQ(554,1,21)
90 ;S PATH=$P($G(^PSX(554,1,"DOD")),"^")
91 S ACKDATE=$P($$FMTHL7^XLFDT(%),"-",1)
92 S ^TMP($J,"ACTREPLY",1)="MSH|^~\&|VistA||CHCS||"_$G(ACKDATE)_"||MFR^M01|"_$G(J)_"|P|2.3.1|||NE|NE"
93 S ^TMP($J,"ACTREPLY",2)="MFE|MUP|"_$G(J)_"|"_$G(ACKDATE)_"|"_$G(SITE)_"|CE"
94 S ^TMP($J,"ACTREPLY",3)="ZLF|4|^"_$G(USER)_"||"_$G(REJ)
95 S FILEN=$G(J)_".SAC"
96 S Y=$$GTF^%ZISH($NA(^TMP($J,"ACTREPLY",1)),2,PATH,FILEN)
97 I $G(Y)'=1 S ERRTXT(2)="Failure writing file: "_FILEN,ERRTXT(3)="Error occurred at ERROR+15^PSXDODAC" G MSG
98 K:Y=1 %,ACKDATE,USER,SITE,^TMP($J,"ACTREPLY"),FILEN,Y,REJ,OK
99 Q
100MSG ;send error message
101 S XMSUB="DoD CMOP Activation Error",ERRTXT(1)="This error indicates a problem reading or writing to a host file"
102MM1 S XMDUZ=.5
103 S XMTEXT="ERRTXT("
104 D GRP1^PSXNOTE
105 D ^XMD
106 Q
107DEACT ;Conjure Deactivation Msg
108 S XMDUZ=.5,XMSUB="CMOP Inactivation Notice, "_SITEN,LCNT=5
109 D XMZ^XMA2 G:XMZ<1 DEACT
110 S ^XMB(3.9,XMZ,2,1,0)="Notice to Inactivate CMOP Processing."
111 S ^XMB(3.9,XMZ,2,2,0)=""
112 S ^XMB(3.9,XMZ,2,3,0)="Facility : "_SITEN
113 S ^XMB(3.9,XMZ,2,4,0)="Notifying Official : "_REQT
114 S ^XMB(3.9,XMZ,2,5,0)="Notification date/time : "_$P(RDTM,":",1,2)
115 S ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_"^"_LCNT_"^"_DT,XMDUN=NAME
116 K XMY S XMDUZ=.5 D GRP^PSXNOTE
117 D ENT1^XMD
118 D NOW^%DTC S OKTIME=$$FMTHL7^XLFDT(%),OKTIME=$P(OKTIME,"-")
119 S FILE=J_".SAC",J=$TR(J,"_","-"),PATH=$$GET1^DIQ(554,1,21)
120 S MSH="MSH|^~\&|VistA||CHCS||"_OKTIME_"||MFR^M02|"_J_"|P|2.3.1|||NE|NE"
121 S MSA="MSA|CA|"_J_"|"
122 K ^TMP($J,"PSXDODAC")
123 S ^TMP($J,"PSXDODAC",1)=MSH
124 S ^TMP($J,"PSXDODAC",2)=MSA
125 F XX=1:1:5 S Y=$$GTF^%ZISH($NA(^TMP($J,"PSXDODAC",1)),3,PATH,FILE) Q:Y=1 H 4
126 I Y'=1 S GBL=$NA(^TMP($J,"PSXDODAC")) D FALERT^PSXDODNT(FILE,PATH,GBL)
127 S PATH=$$GET1^DIQ(554,1,22)
128 F XX=1:1:5 S Y=$$GTF^%ZISH($NA(^TMP($J,"PSXDODAC",1)),3,PATH,FILE) Q:Y=1 H 4
129 I Y'=1 S GBL=$NA(^TMP($J,"PSXDODAC")) D FALERT^PSXDODNT(FILE,PATH,GBL)
130 I $G(Y)'=1 S ERRTXT(2)="Failure writing to file: "_FILE,ERRTXT(3)="Error occurred at REPLY+10^PSXDODAC" G MSG^PSXDODAC
131 Q
Note: See TracBrowser for help on using the repository browser.