source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJUTL3.m@ 901

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

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1PSJUTL3 ;BIR/MLM-MISC. INPATIENT UTILITIES ;29 OCT 01 / 4:29 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**58**;16 DEC 97
3 ;
4 ; Reference to ^PS(55 is supported by DBIA# 2191.
5 ; Reference to ^PSSLOCK is supported by DBIA# 2789.
6 ;
7EN ;
8 Q:$$PATCH^XPDUTL("PSJ*5.0*58")
9 S ZTDTH=$H,ZTRTN="QUEIV^PSJUTL3",ZTIO="",ZTDESC="Inpatient medications - Mark IV orders as verified"
10 D ^%ZTLOAD
11 Q
12QUEIV ;
13 D XTMP
14 NEW DFN,START,PSJX
15 D NOW^%DTC S START=%
16 F DFN=0:0 S DFN=$O(^PS(55,DFN)) Q:'DFN D
17 . S PSJX=$P($G(^PS(55,DFN,5.1)),U,11)
18 . Q:PSJX=3
19 . I PSJX=2 D MARKIV(DFN) Q
20 . D CNIV^PSJUTL1(DFN)
21 D SEND(START)
22 Q
23XTMP ;
24 I '$D(^XTMP("PSJ NEW PERSON",0)) D
25 . NEW X1,X2 S X1=DT,X2=30 D C^%DTC
26 . S ^XTMP("PSJ NEW PERSON",0)=X_U_DT_U_"Correct changed user names"
27 Q
28 ;
29MARKIV(DFN) ;
30 ;Mark the Verifying Pharmacy field for active order created prior
31 ; to PSJ*5*58
32 NEW ON,ON55,X,PSJPINIT,PSJIDT,PSJNOW,PSIVACT
33 Q:'$$L^PSSLOCK(DFN,0)
34 D NOW^%DTC S PSJNOW=$E(%,1,12)
35 S PSJIDT=$$INSTLDT^PSJUTL1() I PSJIDT="" S PSJIDT=PSJNOW
36 S $P(^PS(55,DFN,5.1),U,11)=3
37 F ON=0:0 S ON=$O(^PS(55,DFN,"IV",ON)) Q:'ON D
38 . S X=$G(^PS(55,DFN,"IV",ON,2))
39 . I +X>PSJIDT Q
40 . S PSJPINIT=$P(X,U,11)
41 . NEW XX,XX1,PSJIEN
42 . F XX=0:0 S XX=$O(^PS(55,DFN,"IV",ON,"A",XX)) Q:'XX D
43 .. NEW PSJX S XX1=$G(^PS(55,DFN,"IV",ON,"A",XX,0))
44 .. Q:$P(XX1,U,3)=""
45 .. K PSJIEN S PSJX=""
46 .. I $P(XX1,U,6)="" D
47 ... D NAME^PSJBCMA1($P(XX1,U,3),,,.PSJIEN)
48 ... S:PSJIEN>0 $P(^PS(55,DFN,"IV",ON,"A",XX,0),U,6)=PSJIEN,XX1=^(0)
49 .. Q:+$P($G(^PS(55,DFN,"IV",ON,4)),U,4)
50 .. I $P(XX1,U,2)="F",($P(XX1,U,4)'="FINISHED BY TECHNICIAN") S PSJPINIT=$P(XX1,U,6),PSJX=1
51 .. S:$G(PSJIEN)=-1 ^XTMP("PSJ NEW PERSON",1,$P(XX1,U,3),DFN,ON,XX)=PSJX
52 . Q:+PSJPINIT'>0
53 . Q:+$P($G(^PS(55,DFN,"IV",ON,4)),U,4)
54 . D VF(ON,DFN,PSJPINIT,PSJNOW)
55 D UL^PSSLOCK(DFN)
56 Q
57VF(ON,DFN,PSJPINIT,PSJNOW) ; Update verifying pharm and date fields.
58 K DA,DIE,DR
59 S PSIVACT=""
60 S DIE="^PS(55,"_DFN_",""IV"",",DA=ON,DA(1)=DFN
61 S DR="140////"_PSJPINIT_";141////"_PSJNOW_";142////1" D ^DIE
62 S ON55=ON,PSIVREA="V",PSIVALT=""
63 S PSIVAL="AUTO VERIFIED WITH PATCH PSJ*5*58"
64 D LOG^PSIVORAL K PSIVAL,PSIVALT,PSIVREA
65 Q
66SEND(START) ;
67 NEW DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,STOP,LINE
68 D NOW^%DTC S STOP=%
69 S LINE(1)="Marking prior IV orders as verified started: "_$$FMTE^XLFDT(START)
70 S LINE(2)="It ran to completion: "_$$FMTE^XLFDT(STOP)
71 I $O(^XTMP("PSJ NEW PERSON",0)) D
72 . S LINE(3)=""
73 . S LINE(4)="Please assign the PSJI ACTIVITY LOG VA200 option to a holder of the"
74 . S LINE(5)="PSJI MGR key who is familiar with the Pharmacy users to correct any "
75 . S LINE(6)="names that the software was unable to match to the New Person file (#200)."
76 S XMSUB="PSJ*5*58 IV Verification",XMTEXT="LINE("
77 S XMDUZ="PSJ*5*58"
78 S XMY(+DUZ)="" D ^XMD
79 Q
Note: See TracBrowser for help on using the repository browser.