source: WorldVistAEHR/trunk/r/CMOP-PSX/PSXACT.m@ 1211

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

initial load of WorldVistAEHR
File size: 5.8 KB
RevLine 
[613]1PSXACT ;BIR/WPB/HTW-Activate/Inactive Processing by Host ;02 Aug 2001 11:02AM
2 ;;2.0;CMOP;**1,24,27,38**;11 Apr 97
3 ;Reference to File #200 supported by DBIA 10060
4EXIT S XMZ=$G(TXMZ),XMSER="S.PSXX CMOP SERVER" D:$G(XMZ)>0 REMSBMSG^XMA1C S ZTREQ="@"
5 K %H,Y,DTE,SITE,RTNDOM,CMOP,REQ,XMSUB,XMZ,XMRG,LCNT,XMDUZ,XMDUN,XQA,XQAMSG,XQAROU,RDOM,RDTTM,TXMZ,XMFROM,XMRG,XMSER,XMY,XMZ,XQMSG,XQSOP,ACTFLAG,ACTION,%,DIRUT,MFLAG,OLD,RDTM,REQT,SITEN,SITENUM,XQADATA,XQAID,XQAKILL,RT
6 Q
7EN ;called by taskman to activate a medical center at the cmop facility
8 D NOW^%DTC S RDTTM=% K %
9 S NOACT=0,SITE=$P(XMRG,U,2),CMOP=$P(XMRG,U,4),OLD=$P(XMRG,U,3),SITEN=$P(XMRG,U,5),TXMZ=XMZ,ZTREQ="@"
10 S X=SITEN,AGNCY="VASTANUM" S:$D(^PSX(552,"D",X)) X=$E(X,2,99),AGNCY="DMIS" S SITENUM=$$IEN^XUMF(4,AGNCY,X) K X,AGNCY ;****DOD L1
11 I $G(XMFROM)["@" S RDOM=$P($G(XMFROM),"@",2),REQ=$P($G(XMFROM),"@",1)
12 S:$G(XMFROM)'["@" REQ=XMFROM,RDOM="BAB.ISC-BIRM.VA.GOV"
13 S RT=$P(XMRG,"^",6),REQT=$P(RT,",",2)_" "_$P(RT,",",1)
14 S NAME=$$GET1^DIQ(200,DUZ,.01)
15 G:$G(SITENUM)'>0 NOACT
16 S ACTFLAG=1 D FILE^PSXSITE S MFLAG=0
17 S XMDUZ=.5,XMSUB="CMOP Activation Request, "_SITE,LCNT=5
18 D XMZ^XMA2 G:XMZ<1 EN
19MMSG D NOW^%DTC S RTDTM=% S Y=RTDTM X ^DD("DD") S RDTM=Y K Y,%
20 S ^XMB(3.9,XMZ,2,1,0)="Request to activate CMOP processing."
21 S ^XMB(3.9,XMZ,2,2,0)=""
22 S ^XMB(3.9,XMZ,2,3,0)="Facility : "_SITE
23 S ^XMB(3.9,XMZ,2,4,0)="Requester : "_REQT
24 S ^XMB(3.9,XMZ,2,5,0)="Request date/time: "_$P(RDTM,":",1,2)
25 S ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_"^"_LCNT_"^"_DT,XMDUN=NAME
26 K XMY S XMDUZ=.5 D GRP^PSXNOTE
27 D ENT1^XMD
28 I MFLAG=1 Q
29 S XQADATA=SITE_"^"_$G(RDOM)_"^"_CMOP_"^"_REQT_"^"_OLD_"^"_RTDTM_"^"_SITENUM_"^"_XQSOP_"^"_XQMSG_"^"_SITEN,XQAMSG=SITE_" has submitted a request to activate CMOP processing.",XQAROU="ACT^PSXACT",XQAID="PSXACT"
30 D GRP1^PSXNOTE M XQA=XMY D SETUP^XQALERT
31 G EXIT
32 Q
33ACT S SITE=$P(XQADATA,U,1),CMOP=$P(XQADATA,U,3),(REQ,REQT)=$P(XQADATA,U,4),OLD=$P(XQADATA,U,5),RDTTM=$P(XQADATA,U,6),SITENUM=$P(XQADATA,U,7),RDOM=$P(XQADATA,U,2),XMSER="S."_$P(XQADATA,U,8),TXMZ=$P(XQADATA,U,9),SITEN=$P(XQADATA,U,10)
34 S NAME=$$GET1^DIQ(200,DUZ,.01)
35 D WORK
36 S XQAKILL=0 D DELETE^XQALERT
37 Q
38WORK W !!
39 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"
40 D ^DIR K DIR S ACTION=Y G:($D(DIRUT)) EXIT K Y
41WK S:ACTION="A" ACTFLAG=1
42 S:ACTION="D" ACTFLAG=0
43OK S %H=$H D YX^%DTC S DTE=Y K Y
44 S XMSUB=($S(ACTION="A":"CMOP Activation Approval",ACTION="D":"CMOP Activation Disapproved",1:"")),LCNT=2
45 S XMDUZ=.5 D XMZ^XMA2 G:XMZ<1 OK
46 D NOW^%DTC
47 S NAME=$$GET1^DIQ(200,DUZ,.01)
48 S ^XMB(3.9,XMZ,2,1,0)="$$SYS^"_$S(ACTFLAG=1:"A",ACTFLAG=0:"I",1:"")_"^"_CMOP_"^"_%_"^"_NAME_"^"_OLD
49 S ^XMB(3.9,XMZ,2,2,0)="$$ENDSYS"
50 S ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_U_LCNT_U_DT,XMDUN=NAME
51 K XMY S XMDUZ=.5,XMY($S($G(RDOM)["BAB.":"S.PSXX CMOP SERVER",$G(RDOM)'="":"S.PSXX CMOP SERVER@"_RDOM,1:""))=""
52 K % D ENT1^XMD
53MSG S XMSUB=($S(ACTFLAG=1:"CMOP Activation Approval",ACTFLAG=0:"CMOP Activation Disapproved",1:"")),LCNT=6
54 S XMDUZ=.5 D XMZ^XMA2 G:XMZ<1 MSG
55 S NAME=$$GET1^DIQ(200,DUZ,.01)
56 S ^XMB(3.9,XMZ,2,6,0)="Action taken : "_$S(ACTFLAG=1:"Approved",ACTFLAG=0:"Disapproved",1:"")
57 S ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT+1_U_LCNT+1_U_DT,XMDUN=NAME
58 S MFLAG=1 D MMSG
59 Q:$G(NOACT)=1
60 D FILEA^PSXSITE
61 Q
62 ;Called by Taskman to Deactivate a Remote facility from CMOP
63DEACT S ACTFLAG=0
64 D NOW^%DTC S (Y,RDTTM)=% X ^DD("DD") S RDTM=Y K Y
65 S SITE=$P(XMRG,U,2),OLD=$P(XMRG,U,3),CMOP=$P(XMRG,U,4),SITEN=$P(XMRG,U,5),XMSER="S."_XQSOP,TXMZ=XQMSG
66 ;S DIC="4",DIC(0)="OXMZ",X=SITEN S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S SITENUM=+Y K DIC,X,Y ;****DOD L1
67 S X=SITEN,AGNCY="VASTANUM" S:$D(^PSX(552,"D",X)) X=$E(X,2,99),AGNCY="DMIS" S SITENUM=$$IEN^XUMF(4,AGNCY,X) K X,AGNCY ;****DOD L1
68 I $G(XMFROM)["@" S RDOM=$P($G(XMFROM),"@",2),REQ=$P($G(XMFROM),"@",1)
69 S:$G(XMFROM)'["@" REQ=XMFROM,RDOM="BAB.ISC-BIRM.VA.GOV"
70 S RT=$P(XMRG,"^",6),REQT=$P(RT,",",2)_" "_$P(RT,",",1)
71 S NAME=$$GET1^DIQ(200,DUZ,.01)
72 D FILE^PSXSITE
73 S XMDUZ=.5,XMSUB="CMOP Inactivation Notice, "_SITE,LCNT=5
74DXMZ D XMZ^XMA2 G:XMZ<1 DXMZ
75 S ^XMB(3.9,XMZ,2,1,0)="Notice to Inactivate CMOP Processing."
76 S ^XMB(3.9,XMZ,2,2,0)=""
77 S ^XMB(3.9,XMZ,2,3,0)="Facility : "_SITE
78 S ^XMB(3.9,XMZ,2,4,0)="Notifying Official : "_REQT
79 S ^XMB(3.9,XMZ,2,5,0)="Notification date/time : "_$P(RDTM,":",1,2)
80 S ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_"^"_LCNT_"^"_DT,XMDUN=NAME
81 K XMY S XMDUZ=.5 D GRP^PSXNOTE
82 D ENT1^XMD
83 S XMDUZ=.5,XMSUB=("CMOP Inactivation Notice"),LCNT=1
84RXMZ D XMZ^XMA2 G:XMZ<1 RXMZ
85 S ^XMB(3.9,XMZ,2,1,0)="$$SYS^"_"D"_"^"_CMOP_"^"_$G(RDTTM)_"^"_NAME_"^"_OLD
86 S ^XMB(3.9,XMZ,2,0)="^3.92A^"_LCNT_"^"_LCNT_"^"_DT,XMDUN=NAME
87 K XMY,% S XMDUZ=.5,XMY($S($G(RDOM)="":"S.PSXX CMOP SERVER",$G(RDOM)'="":"S.PSXX CMOP SERVER@"_RDOM,1:""))=""
88 D ENT1^XMD
89 D GRP^PSXNOTE
90 S XQAMSG=SITE_" has inactivated CMOP processing." D GRP1^PSXNOTE M XQA=XMY D SETUP^XQALERT
91 G EXIT
92NOACT N XQA,XQAMSG
93 S XQAFLG="D",ACTION="D",NOACT=1
94 S XQAMSG=SITE_" Activation disapproved, bad entry in Institution File." D GRP^PSXNOTE D GRP1^PSXNOTE M XQA=XMY D SETUP^XQALERT,WK
95 N XMZ S XMSUB="CMOP Activation Request Disapproved",XMDUN="CMOP Manager",XMDUZ=.5
96NOMSG D XMZ^XMA2 G:XMZ<1 NOMSG
97 S ^XMB(3.9,XMZ,2,1,0)=SITE_" Requested to activate, but was denied."
98 S ^XMB(3.9,XMZ,2,2,0)="The request was disapproved because there are multiple entries"
99 S ^XMB(3.9,XMZ,2,3,0)="in the Institution file with the same Station Number or"
100 S ^XMB(3.9,XMZ,2,4,0)="there wasn't an entry in the Institution file for the Station Number."
101 S ^XMB(3.9,XMZ,2,5,0)=""
102 S ^XMB(3.9,XMZ,2,6,0)="Please check the Institution file for "_$G(SITE)_"."
103 S ^XMB(3.9,XMZ,2,7,0)="Station Numbers are unique. There should only be one entry in the file for"
104 S ^XMB(3.9,XMZ,2,8,0)="a station number."
105 S ^XMB(3.9,XMZ,2,0)="^3.92A^8^8^"_DT
106 K XMY D GRP^PSXNOTE D ENT1^XMD
107 K XMY,XMZ,XMSUB
108 G EXIT
Note: See TracBrowser for help on using the repository browser.