source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVPGE.m@ 1800

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

initial load of WorldVistAEHR
File size: 4.6 KB
RevLine 
[613]1PSIVPGE ;BIR/PR-PURGE IV ORDERS ;05 DEC 97 / 8:44 AM
2 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
3 ;
4EN ;
5 N XQUIT D ^PSIVXU Q:$D(PSIVXU) D VW
6Q W:'$D(PSIVPR)&($Y) @IOF S:$D(ZTQUEUED) ZTREQ="@" K DFN,N,ON,P,P17,PS,PSIVDT,PSIVLAB,PSIVLOG,PSIVPN,PSIVRD,PSIVREA,PSIVPDT,PSIVVO,PSJACNWP,Z,ZTSK D ENIVKV^PSGSETU
7 Q
8VW ;Ask user to view order.
9 S (PSIVLOG,PSIVLAB)=0 W !!,"View orders before purged" S %=1 D YN^DICN G:%=-1 Q I %=0 S HELP="PRTVW" D ^PSIVHLP1 G VW
10 S PSIVVO=%[1 I PSIVVO,PSIVPR=ION W $C(7),!!,"WARNING -- YOU HAVE NOT SELECTED A PRINTER PROFILE DEVICE !!"
11 ;
12VW1 ;Ask user to view activity log.
13 I PSIVVO W !,"View activity logs before purged" S %=1 D YN^DICN G:%=-1 Q S PSIVLOG=%[1 I %=0 S HELP="PRTAVW" D ^PSIVHLP1 G VW1
14 ;
15VW2 ;Ask to view label log
16 I PSIVVO W !,"View label logs before purged" S %=1 D YN^DICN G:%=-1 Q S PSIVLAB=%[1 I %=0 S HELP="LABLOG" D ^PSIVHLP2 G VW2
17BEG ;Start purge
18 S HELP="PURGE" D ^PSIVHLP W ! S %DT="ETA",%DT("A")="Purge orders older than what date: " D ^%DT G:Y<0 Q
19 S PSIVPDT=Y D NOW^%DTC S Y=% S X1=Y,X2=PSIVPDT D ^%DTC I X<30 W $C(7),!,"Enter a date greater than 30 days ago.",! G BEG
20 ;
21YN ;Make sure it is ok to start purge.
22 W !!,"Will purge expired IV orders from " S Y=PSIVPDT X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2),"back.",!,"Ok to start purge" S %=2 D YN^DICN I %=0 S HELP="YNPRG" D ^PSIVHLP1 G YN
23 G:%=-1!(%=2) Q
24 I PSIVPR'=ION S ZTDESC="PURGE IV ORDERS",ZTRTN="DEQ^PSIVPGE",(ZTSAVE("PSIVLOG"),ZTSAVE("PSIVLAB"),ZTSAVE("PSIVSITE"),ZTSAVE("PSIVPDT"),ZTSAVE("PSIVVO"),ZTSAVE("PSIVSN"),ZTSAVE("PSJSYSW0"),ZTSAVE("PSJSYSU"))="",ZTIO=PSIVPR D ^%ZTLOAD G Q
25 ;
26DEQ W:$Y @IOF S PSIVPN=0,Y=PSIVPDT,PSIVSLV=IO'=IO(0)!(IOST'["C-") X ^DD("DD") W:PSIVSLV !,"Purge expired IV orders from ",$P(Y,"@")," ",$P(Y,"@",2)," back.",!,"Time started: "
27 D NOW^%DTC S Y=$E(%,1,12) X ^DD("DD") W:PSIVSLV $P(Y,"@")," ",$P(Y,"@",2),!!
28 S PSIVPDT=PSIVPDT+1,PSIVRD=1
29 F PSIVDT=0:0 S PSIVDT=$O(^PS(55,"AIV",PSIVDT)) Q:PSIVDT>PSIVPDT!('PSIVDT)!$D(DIRUT) D
30 .F DFN=0:0 S DFN=$O(^PS(55,"AIV",PSIVDT,DFN)) Q:'DFN!$D(DIRUT) D:PSIVVO&(PSIVDT>1) ENNA^PSIVACT S PSJACNWP=1 D ENIV^PSJAC F ON=0:0 S ON=$O(^PS(55,"AIV",PSIVDT,DFN,ON)) Q:'ON!$D(DIRUT) D PRGE
31 I '$D(DIRUT) W !!,"Time finished: " D NOW^%DTC S Y=% X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2) W !,"Number of IV ORDERS purged is: ",PSIVPN,!!
32 D Q
33 Q
34PRGE ;
35 I $D(^PS(55,DFN,"IV",ON,2)) I $P(^(2),"^",2)'=PSIVSN&$P(^(2),"^",2)!(^(2)>PSIVPDT&($P(^PS(55,DFN,"IV",ON,0),"^",3)'=1)) Q
36 I $G(^PS(55,DFN,"IV",ON,"ADC")) S TDC=+^("ADC") K ^PS(55,"ADC",TDC,DFN,ON),TDC
37 I PSIVVO,$D(^PS(55,DFN,"IV",ON,0)),PSIVDT>1 S (P("PON"),ON55)=ON_"V" D GT55^PSIVORFB,ENNONUM^PSIVORV2(DFN,ON) S PSIVPN=PSIVPN+1 D PAUSE Q:$D(DIRUT)
38 I 'PSIVVO,$D(^PS(55,DFN,"IV",ON,0)),PSIVDT>1 S PSIVPN=PSIVPN+1 W:'(PSIVPN#100) "."
39 I PSIVLOG,$D(^PS(55,DFN,"IV",ON,0)),PSIVDT>1 S PSJORD=ON55 D ENLOG^PSIVVW1,PAUSE Q:$D(DIRUT)
40 S ON=+ON ;* ^PSIVVW1 set ON=PSJORD and PSJORD is concatenated to "V"
41 I PSIVLAB,$D(^PS(55,DFN,"IV",ON,0)),PSIVDT>1 D DATA^PSIVLTR1(DFN,ON),PAUSE Q:$D(DIRUT)
42 D DCNV^PSIVOE S X=$G(^PS(55,DFN,"IV",ON,0)) Q:'X
43 K ^PS(55,"PSIVSUS",PSIVSN,DFN,ON),^PS(55,"AIV",PSIVDT,DFN,ON),^PS(55,DFN,"IV",ON),^PS(55,DFN,"IV","B",ON)
44 K:$D(^PS(55,DFN,"IV","AIT",$P(X,U,4),$P(X,U,3),ON)) ^PS(55,DFN,"IV","AIT",$P(X,U,4),$P(X,U,3),ON)
45 K:$D(^PS(55,DFN,"IV","AIS",$P(X,U,3),ON)) ^PS(55,DFN,"IV","AIS",$P(X,U,3),ON)
46 I $D(^PS(55,DFN,"IV",0)),$P(^(0),"^",4) S $P(^(0),"^",4)=$P(^(0),"^",4)-1
47 Q
48 ;
49PAUSE ;
50 I 'PSIVSLV K DIR S DIR(0)="E" D ^DIR
51 Q
52 ;
53ENT ;Will let user delete an IV order if no doses printed.
54 D FULL^VALM1
55 S PSJORD=ON D ENNH^PSIVORV2(ON)
56 D A,PAUSE^PSJLMUTL
57 Q
58A W !,"Delete this order" S %=2 D YN^DICN I %=0 S HELP="OPUR" D ^PSIVHLP1 G A
59 I %=-1!(%=2) W $C(7)," Order not deleted." Q
60 S ON=+ON55 I $D(^PS(55,DFN,"IV",ON,9)) S Y=^(9) I $P(Y,"^",2) W !,"Order # ",ON," ... Not deleted ",$P(Y,"^",2)," dose(s) given " S Y=+Y X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2) Q
61 D ENDEL W " Order deleted." Q
62ENDEL ;D DCNV^PSIVOE S X=^PS(55,DFN,"IV",ON,0) S $P(X,U,17)="P" K:$P(X,U,3)]"" ^PS(55,"AIV",$P(X,U,3),DFN,ON) S $P(X,U,3)=1,^PS(55,DFN,"IV",ON,0)=X,^PS(55,"AIV",1,DFN,ON)="" I $D(^PS(55,DFN,"IV",ON,"ADC")) S TC=^("ADC") K ^PS(55,"ADC",TC,DFN,ON)
63 D DCNV^PSIVOE S X=$G(^PS(55,DFN,"IV",ON,0)) Q:'X S $P(X,U,17)="P"
64 K:$P(X,U,3)]"" ^PS(55,"AIV",$P(X,U,3),DFN,ON)
65 K:$D(^PS(55,DFN,"IV","AIT",$P(X,U,4),$P(X,U,3),ON)) ^PS(55,DFN,"IV","AIT",$P(X,U,4),$P(X,U,3),ON)
66 K:$D(^PS(55,DFN,"IV","AIS",$P(X,U,3),ON)) ^PS(55,DFN,"IV","AIS",$P(X,U,3),ON)
67 S $P(X,U,3)=1,^PS(55,DFN,"IV",ON,0)=X,^PS(55,"AIV",1,DFN,ON)="",^PS(55,DFN,"IV","AIT",$P(X,U,4),1,ON)="",^PS(55,DFN,"IV","AIS",1,ON)=""
68 I $D(^PS(55,DFN,"IV",ON,"ADC")) S TC=^("ADC") K ^PS(55,"ADC",TC,DFN,ON)
Note: See TracBrowser for help on using the repository browser.