source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJIPST.m@ 1259

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1PSJIPST ;BIR/CML3-POST INIT DRIVER ;11 DEC 97 / 3:11 PM
2 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
3 ;
4 D MES^XPDUTL(" ")
5 S PSJIPSTF=1 D NOW^%DTC D YX^%DTC S PSJMESSG="POST-INIT STARTED AT "_Y_" ...." D MES^XPDUTL(PSJMESSG)
6 ;
7 ;Set flags and skip conversions if virgin install.
8 I $D(PSGINITF) D
9 .D NOW^%DTC S ^PS(59.7,1,20.5)=%_"^"_%_"^"_%_"^"_% D:XPDQUES("POS1")=1 VIRGIN
10 D ^PSJIPSTA
11 ;
12 ; Connect movement event driver
13 D:'$P($G(^PS(59.7,1,20.5)),U,2) START^PSJIPST1
14 ;
15 ; Do Unit Dose Order Sets conversion
16 D:'$P($G(^PS(59.7,1,20.5)),U,4) 111^PSJIPST3
17 ;
18UPF ; update package file, if necessary .... took this code out
19DONE ;
20 F X="AUDDD","AUDAPM","ALCNVRT" S ^PS(55,X)=+$P($T(PSJIPST+1),";",3)
21 ;
22 ; Queue 5.0 order conversion.
23 ; called from OERR now
24 ;D:('$P($G(^PS(59.7,1,20.5)),U,2))&('$D(PSGINITF)) ENORDER^PSJIPST1,ENIVKV^PSGSETU
25 ;
26 ; Queue 5.0 pick list conversion.
27 D:'$P($G(^PS(59.7,1,20.5)),U,3) ENPL^PSJIPST1
28 ; Queue 5.0 Unit Dose Verification conversion.
29 D:'$P($G(^PS(59.7,1,20.5)),U) ENPVNV^PSJIPST2
30 D SNMM,ENUPO
31 D MES^XPDUTL(" ")
32 D NOW^%DTC S $P(^PS(59.7,1,20),"^",1,3)=+$P($T(PSJIPST+1),";",3)_"^"_%_"^"_DUZ,Y=% D YX^%DTC S PSJMESSG="POST-INSTALL COMPLETED AT "_Y_" ...." D MES^XPDUTL(PSJMESSG)
33 ; fill in ^XTMP zero nodes
34 N PSJDATE1,PSJDATE2
35 D NOW^%DTC S PSJDATE1=X,X1=X,X2=7 D C^%DTC S PSJDATE2=X
36 S ^XTMP("PSJ NEW PERSON",0)=PSJDATE2_"^"_PSJDATE1_"^"_"List of changed User Names in IV orders"
37 Q
38 ;
39VIRGIN ; Queue process to mark all drugs as UD items (Virgin install only).
40 K ZTSAVE,ZTSK S ZTRTN="ENMUD^PSJIPST1",ZTDTH=$H,ZTDESC="MARK ALL DISPENSE DRUGS AS UNIT DOSE ITEMS (INPATIENT MEDS POST-INSTALL)",ZTIO="" D ^%ZTLOAD
41 S PSJMESSG="... the process to mark all ACTIVE drugs in your local drug file as Unit Dose items is"_$S($D(ZTSK):"",1:"NOT")_" queued." D MES^XPDUTL(PSJMESSG)
42 I $D(ZTSK) D MES^XPDUTL(" (to start NOW). YOU WILL RECEIVE A MAILMAN MESSAGE WHEN THE TASK HAS COMPLETED.")
43 Q
44 ;
45SNMM ;
46 N PSG,XMY S XMSUB="INPATIENT MEDICATIONS "_$P($T(PSJIPST+1),";",3)_" INSTALL COMPLETED",XMY("MIMS,M@ISC-BIRM.VA.GOV")="",XMDUZ=DUZ,XMTEXT="PSG(",%H=$H D YX^%DTC
47 S PSG(1,0)=" "
48 S PSG(2,0)=" "_$P($$SITE^VASITE(),"^",2)_" HAS RUN THE INPATIENT MEDICATION V"_$P($T(PSJIPST+1),";",3)_" INSTALL"
49 S PSG(3,0)="TO COMPLETION AS OF "_Y_"."
50 N DIFROM D ^XMD K SITE Q
51 ;
52ENUPO ; update options when conversions done
53 ; get list of Pick List options IENs, these will not be enabled until
54 ; the end of the pick list conversion
55 S PSJOPLIS="|"_+$O(^DIC(19,"B","PSJU PLDEL",0))_"|"
56 S PSJOPLIS=PSJOPLIS_+$O(^DIC(19,"B","PSJU PLAPS",0))_"|"
57 S PSJOPLIS=PSJOPLIS_+$O(^DIC(19,"B","PSJU PLPRG",0))_"|"
58 S PSJOPLIS=PSJOPLIS_+$O(^DIC(19,"B","PSJU PLDP",0))_"|"
59 S PSJOPLIS=PSJOPLIS_+$O(^DIC(19,"B","PSJU EUD",0))_"|"
60 S PSJOPLIS=PSJOPLIS_+$O(^DIC(19,"B","PSJU PL",0))_"|"
61 S PSJOPLIS=PSJOPLIS_+$O(^DIC(19,"B","PSJU RET",0))_"|"
62 S PSJOPLIS=PSJOPLIS_+$O(^DIC(19,"B","PSJU PLRP",0))_"|"
63 S PSJOPLIS=PSJOPLIS_+$O(^DIC(19,"B","PSJU PLATCS",0))_"|"
64 S PSJOPLIS=PSJOPLIS_+$O(^DIC(19,"B","PSJU PLUP",0))_"|"
65 D MES^XPDUTL("...removing the 'OUT OF ORDER' message from the Inpatient Medications options...")
66 S Q1="PSJ" F S Q1=$O(^DIC(19,"B",Q1)) Q:$E(Q1,1,3)'="PSJ" F Q2=0:0 S Q2=$O(^DIC(19,"B",Q1,Q2)) Q:'Q2 D
67 .S DIE="^DIC(19,",DA=Q2,DR="2///@" D:PSJOPLIS'[("|"_Q2_"|") ^DIE
68 D MES^XPDUTL("...removing the 'DISABLE' message from the Inpatient Medications protocols...")
69 S Q1="PSJ" F S Q1=$O(^ORD(101,"B",Q1)) Q:$E(Q1,1,3)'="PSJ" F Q2=0:0 S Q2=$O(^ORD(101,"B",Q1,Q2)) Q:'Q2 S DIE="^ORD(101,",DA=Q2,DR="2///@" D ^DIE
70 ; if package is reinstalled and Pick list conversion has finished
71 ; the options will be reactivated again
72 D:$P($G(^PS(59.7,1,20.5)),U,3) ACTPK^PSJIPST2
73 D PURG
74 K DA,DIE,DR,PSJOPLIS,Q1,Q2,X,Y
75 Q
76PURG ; Place PURGE options as OUT OF ORDER
77 ; take this out later!!!!!!! keeps users from using the purge options
78 N NAME,IEN
79 F NAME="PSJU PO PURGE","PSJI PURGE","PSJI PURGE ORDERS" S IEN=$O(^DIC(19,"B",NAME,0)) S DIE="^DIC(19,",DA=IEN,DR="2////TEMPORARILY UNAVAILABLE" D ^DIE K DIE
80 Q
Note: See TracBrowser for help on using the repository browser.