source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVRP1.m@ 1703

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1PSIVRP1 ;BIR/MLM-REPRINT IV LABELS FROM WARD OR MANUFACTURING LIST (CONT. FROM PSIVRP) ;20 JUN 94 / 3:22 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**58**;16 DEC 97
3 ;
4 ; Reference to ^PS(55 is supported by DBIA 2191.
5 ;
6DEQ ;
7 S STR=$S(LAST("LIST")="M":"LIST^PSIVT^PSIVDT^X1^X2^DFN^ON",1:"LIST^PSIVT^WRD^PSIVDT^DFN^ON") F X=1:1:$L(STR,"^") S @$P(STR,"^",X)=LAST($P(STR,"^",X))
8 S PSIVT=$E(PSIVDT,1),PSIVOD(PSIVT)=$E(PSIVDT,2,$L(PSIVDT)) D @($S($D(^PS(55,"PSIVWLM",PSIVSN,PSIVDT)):"MONL",1:"WONL")),QUIT
9 Q
10GTDATE ;
11 I $D(PSR) S PSIVDT=$O(PSR(PSIVDT)) Q:PSIVDT="" S PSIVT=$E(PSIVDT,1),PSIVOD(PSIVT)=$E(PSIVDT,2,$L(PSIVDT)) D @($S($D(^PS(55,"PSIVWLM",PSIVSN,PSIVDT)):"X1",1:"WRD"))
12 Q
13WONL ;
14 L +^PS(55,"PSIVWL",PSIVSN):1 E W:$Y @IOF W !!,"**** WARNING --- LABELS NOT RUN, WARD LIST IN PROGRESS" Q
15 D WON L -^PS(55,"PSIVWL",PSIVSN)
16 Q
17MONL ;
18 L +^PS(55,"PSIVWLM",PSIVSN):1 E W:$Y @IOF W !!,"**** WARNING --- LABELS NOT RUN, MANUFACTURING LIST IN PROGRESS",! Q
19 D MON L -^PS(55,"PSIVWLM",PSIVSN)
20 Q
21WRD ;
22 S WRD=$O(^PS(55,"PSIVWL",PSIVSN,WRD)) G:WRD=""!(PSIVDT="") GTDATE I WRD="",('$D(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVDT))) G GTDATE
23WDFN ;
24 S DFN=$O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVDT,DFN)) G:DFN="" WRD
25WON ;
26 S ON=$O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVDT,+DFN,ON)) G:ON="" WDFN Q:DFN=NEXT("DFN")&(ON=NEXT("ON")) D MEOWRPT^PSIVLBL1 G WON
27 Q
28X1 ;
29 S X1=$O(^PS(55,"PSIVWLM",PSIVSN,PSIVDT,PSIVT,X1)) I X1="" S WRD="" G GTDATE
30X2 ;
31 S X2=$O(^PS(55,"PSIVWLM",PSIVSN,PSIVDT,PSIVT,X1,X2)) G:X2="" X1
32MDFN ;
33 S DFN=$O(^PS(55,"PSIVWLM",PSIVSN,PSIVDT,PSIVT,X1,X2,DFN)) G:DFN="" X2
34MON ;
35 S ON=$O(^PS(55,"PSIVWLM",PSIVSN,PSIVDT,PSIVT,X1,X2,+DFN,ON)) G:ON="" MDFN Q:DFN=NEXT("DFN")&(ON=NEXT("ON")) S WRD=$S($D(^PS(55,"PSIVWLM",PSIVSN,PSIVDT,PSIVT,X1,X2,DFN,ON)):$P(^(ON),"^",2),1:"") D MEOWRPT^PSIVLBL1 G MON
36 Q
37GTMES ;
38 S (WRD,ON)="" F X=0:0 S WRD=$O(^PS(55,"PSIVWL",PSIVSN,WRD)) Q:WRD="" S PSIVDT="" F X=0:0 S PSIVDT=$O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVDT)) Q:PSIVDT="" I PSIVDT[Y D GTMES1
39 Q
40GTMES1 ;
41 S DFN="" F X=0:0 S DFN=$O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVDT,DFN)) Q:DFN=""!$D(PS(PSIVDT)) S ON="" F X=0:0 S ON=$O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVDT,DFN,ON)) Q:ON=""!(ON="OK") D GTMES2
42 Q
43GTMES2 ;
44 I $D(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVDT,DFN,ON)),$P(^(ON),"^",4) S PS(PSIVDT)=""
45 Q
46QUIT ;
47 K C,D1,DFN,DIC,FILE,I,J,JJ,LAST,LIST,NAD,NEXT,NF,ON,P,POP,PRO,PS,PSCT,PSIVCD,PSIVMT,PSIVNOL,PSGDT,PSM,PSR,PSIVDRG,PSIVDT,PSIVDTS,PSIVST,PSIVT,PSIVOD,STR
48 K VAERR,WRD,X1,X2,X3,XT,XQUIT,Z,ZTDESC,ZTIO,ZTRTN,ZTSAVE D ENIVKV^PSGSETU S:$D(ZTQUEUED) ZTREQ="@"
49 Q
Note: See TracBrowser for help on using the repository browser.