source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAREORD.m@ 635

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

initial load of FOIAVistA 6/30/08 version
File size: 5.7 KB
Line 
1PSAREORD ;BIR/JMB-Nightly Background Job - CONT'D ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,21**; 10/24/97
3 ;References to ^PSDRUG( are covered by IA #2095
4 ;References to ^DIC(51.5 are covered by IA #1931
5 ;This routine checks each pharmacy location for current balances less
6 ;than or equal to the reorder level. A list is sent to the holders of
7 ;the PSA ORDERS key. If the location is a master vault, the message
8 ;will include those CS drugs only if the user has the PSJ RPHARM key.
9 ;
10PHARM ;Looks for drugs that are >= reorder level in pharmacy locations.
11 K ^TMP("PSAMSGO",$J),^TMP("PSAREORD",$J) S (PSACNT,PSALOC)=0
12 F S PSALOC=$O(^PSD(58.8,"ADISP","P",PSALOC)) Q:'PSALOC D
13 .Q:'$P($G(^PSD(58.8,PSALOC,0)),"^",14)!('$D(^PSD(58.8,PSALOC,0)))
14 .I +$G(^PSD(58.8,PSALOC,"I")),+^PSD(58.8,PSALOC,"I")'>DT Q
15 .S PSAFIRST=1,PSADRG=0
16 .F S PSADRG=+$O(^PSD(58.8,PSALOC,1,PSADRG)) Q:'PSADRG D
17 ..S PSANODE=$G(^PSD(58.8,PSALOC,1,PSADRG,0)) Q:PSANODE=""
18 ..Q:+$P(PSANODE,"^",4)>+$P(PSANODE,"^",5)
19 ..Q:'+$P(PSANODE,"^",4)&('+$P(PSANODE,"^",5))
20 ..S PSANDC=$P($G(^PSDRUG(PSADRG,2)),"^",4) K PSALVSN D:PSANDC'="" NDC
21 ..S ^TMP("PSAORD",$J,PSALOC,$S($P($G(^PSDRUG(PSADRG,0)),"^")'="":$P(^PSDRUG(PSADRG,0),"^"),1:"UNKNOWN ("_PSADRG_")"))=+$P(PSANODE,"^",3)_"^"_+$P(PSANODE,"^",4)_"^"_$G(PSALVSN)
22 K PSALVSN
23 ;
24VAULT ;Looks for drugs that are >= reorder level in master vaults.
25 S PSALOC=0 F S PSALOC=$O(^PSD(58.8,"ADISP","M",PSALOC)) Q:'PSALOC D
26 .Q:'$P($G(^PSD(58.8,PSALOC,0)),"^",14)!('$D(^PSD(58.8,PSALOC,0)))
27 .I +$G(^PSD(58.8,PSALOC,"I")),+^PSD(58.8,PSALOC,"I")'>DT Q
28 .S PSAFIRST=1,PSADRG=0
29 .F S PSADRG=$O(^PSD(58.8,PSALOC,1,PSADRG)) Q:'PSADRG D
30 ..S PSANODE=$G(^PSD(58.8,PSALOC,1,PSADRG,0))
31 ..Q:PSANODE=""!(+$P(PSANODE,"^",4)>+$P(PSANODE,"^",5))
32 ..Q:'+$P(PSANODE,"^",4)&('+$P(PSANODE,"^",5))
33 ..S PSANDC=$P($G(^PSDRUG(PSADRG,2)),"^",4) K PSALVSN D:PSANDC'="" NDC
34 ..S ^TMP("PSAORDCS",$J,PSALOC,$S($P($G(^PSDRUG(PSADRG,0)),"^")'="":$P(^PSDRUG(PSADRG,0),"^"),1:"UNKNOWN ("_PSADRG_")"))=+$P(PSANODE,"^",3)_"^"_+$P(PSANODE,"^",4)_"^"_$G(PSALVSN)
35 K PSALVSN I '$O(^TMP("PSAORD",$J,0)),'$O(^TMP("PSAORDCS",$J,0)) G EXIT
36 ;
37NONCS ;Loops through the non-controlled subs to create mail message text.
38 G:'$O(^TMP("PSAORD",$J,0)) CS K PSA S (PSACNT,PSALOC)=0
39 F S PSALOC=$O(^TMP("PSAORD",$J,PSALOC)) Q:'PSALOC D
40 .S PSAFIRST=1,PSADRG=""
41 .F S PSADRG=$O(^TMP("PSAORD",$J,PSALOC,PSADRG)) Q:PSADRG="" D
42 ..S PSASTOCK=$P(^TMP("PSAORD",$J,PSALOC,PSADRG),"^"),PSABAL=$P(^(PSADRG),"^",2),PSAVSN=$P(^(PSADRG),"^",3) D SETMSG
43 G:'$D(^XUSEC("PSJ RPHARM",DUZ))!('$O(^TMP("PSAORDCS",$J,0))) SEND
44 ;
45CS ;Loops through the controlled subs to create mail message text.
46 S PSALOC=0 F S PSALOC=$O(^TMP("PSAORDCS",$J,PSALOC)) Q:'PSALOC D
47 .S PSAFIRST=1,PSADRG=""
48 .F S PSADRG=$O(^TMP("PSAORDCS",$J,PSALOC,PSADRG)) Q:PSADRG="" D
49 ..S PSASTOCK=$P(^TMP("PSAORDCS",$J,PSALOC,PSADRG),"^"),PSABAL=$P(^(PSADRG),"^",2),PSAVSN=$P(^(PSADRG),"^",3) D SETMSG
50 ;
51SEND ;Send the mail message to the holders of the PSA ORDERS key.
52 S XMTEXT="^TMP(""PSAMSGO"",$J,",XMDUZ="Drug Accountability System",XMSUB="Drug Balances Below Reorder Level"
53 ;PSA*3*21 ( change recipients to PSA REORDER LEVEL mail group
54 S XMY("G.PSA REORDER LEVEL")=""
55 G:'$D(XMY) QUIT D ^XMD
56QUIT K XMY,^TMP("PSAMSGO",$J)
57 Q
58 ;
59NDC ;Gets VSN dispense units,dispense units/order unit, order unit for
60 ;^TMP global
61 K PSASYN,PSAVSN,PSAOU,PSADUOU,PSADU,PSALVSN
62 S PSANDC=$E("000000",1,(6-$L($P(PSANDC,"-"))))_$P(PSANDC,"-")_$E("0000",1,(4-$L($P(PSANDC,"-",2))))_$P(PSANDC,"-",2)_$E("00",1,(2-$L($P(PSANDC,"-",3))))_$P(PSANDC,"-",3)
63 S PSASYN=+$O(^PSDRUG("C",PSANDC,PSADRG,0)) Q:'PSASYN!('$D(^PSDRUG(PSADRG,1,PSASYN,0)))
64 S PSAVSN=$P(^PSDRUG(PSADRG,1,PSASYN,0),"^",4),PSAOU=$S(+$P(^(0),"^",5):$P($G(^DIC(51.5,+$P(^(0),"^",5),0)),"^"),1:"")
65 S PSADUOU=$S(+$P(^PSDRUG(PSADRG,1,PSASYN,0),"^",7):+$P(^(0),"^",7),1:""),PSADU=$P($G(^PSDRUG(PSADRG,660)),"^",8)
66 Q:PSAVSN=""
67 S PSALVSN="VSN: "_PSAVSN I PSAOU'="",+PSADUOU,PSADU'="" S PSALVSN=PSALVSN_" "_PSADUOU_" "_PSADU_"/"_PSAOU
68 K PSASYN,PSAVSN,PSAOU,PSADUOU,PSADU
69 Q
70SETMSG ;Creates the body of the mail message.
71 I PSAFIRST D
72 .I PSACNT'=0 S PSACNT=PSACNT+1,^TMP("PSAMSGO",$J,PSACNT)="=============================================================================",PSACNT=PSACNT+1,^TMP("PSAMSGO",$J,PSACNT)=" "
73 .K PSALOCA D SITES^PSAUTL1 S PSALOCA($P(^PSD(58.8,PSALOC,0),"^")_PSACOMB,PSALOC)=PSAISIT_"^"_PSAOSIT,PSALOCN=$O(PSALOCA("")),PSAFIRST=0
74 .S PSACNT=PSACNT+1,PSACNT(PSACNT)=$S($P(^PSD(58.8,PSALOC,0),"^",2)="P":"PHARMACY LOCATION",1:"MASTER VAULT")
75 .I $L(PSALOCN)>76 S PSACNT=PSACNT+1,^TMP("PSAMSGO",$J,PSACNT)=$P(PSALOCN,"(IP)",1)_"(IP)" S PSACNT=PSACNT+1,^TMP("PSAMSGO",$J,PSACNT)=" "_$P(PSALOCN,"(IP)",2)
76 .I $L(PSALOCN)<77 S PSACNT=PSACNT+1,^TMP("PSAMSGO",$J,PSACNT)=PSALOCN
77 .S PSACNT=PSACNT+1,^TMP("PSAMSGO",$J,PSACNT)=" Stock Current Amount to"
78 .S PSACNT=PSACNT+1,^TMP("PSAMSGO",$J,PSACNT)="Drug Name: Level Balance Order"
79 .S PSACNT=PSACNT+1,^TMP("PSAMSGO",$J,PSACNT)="-----------------------------------------------------------------------------"
80 S PSALEN=$L(PSADRG),PSASPACE=$E(" ",1,(42-PSALEN))
81 S PSACNT=PSACNT+1,^TMP("PSAMSGO",$J,PSACNT)=PSADRG_PSASPACE_$J(PSASTOCK,6,0)_" "_$J(PSABAL,6,0)_" "_$S((PSASTOCK-PSABAL)>.001:$J((PSASTOCK-PSABAL),6,0),1:" N/A")
82 S PSACNT=PSACNT+1 S:$G(PSAVSN)'="" ^TMP("PSAMSGO",$J,PSACNT)=" "_PSAVSN
83 Q
84 ;
85EXIT ;Kills the variables & TMP globals.
86 K ^TMP("PSAMSGO",$J),^TMP("PSAORD",$J),^TMP("PSAORDCS",$J)
87 K PSA,PSABAL,PSACNT,PSACOMB,PSADRG,PSAFIRST,PSAISIT,PSALEN,PSALOC,PSALOCA,PSALOCN,PSANODE,PSAOSIT,PSAISITN,PSAOSITN,PSASPACE,PSASTOCK,XMDUZ,XMSUB,XMTEXT,XMY
88 Q
Note: See TracBrowser for help on using the repository browser.