source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVWL1.m@ 701

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1PSIVWL1 ;BIR/RGY-WARD LIST ROUTINES ;02 AUG 96 / 9:40 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**81**;16 DEC 97
3 ;
4 ; Reference to ^PS(55 is supported by DBIA 2191
5 ; Reference to ^VA(200 is supported by DBIA 10060
6 ;
7SELMAN ;
8 K PSM,PSIVMT,PSIVOD,PSIVCD S PSCT=0 F I=0:0 S I=$O(^PS(59.5,PSIVSN,2,I)) Q:'I S PSM(I)=^(I,0),PSCT=PSCT+1
9P W !!?5,"The manufacturing times on file are:"
10P0 F I=0:0 S I=$O(PSM(I)) Q:'I S X=PSM(I) W !?10,I," ",$E($P(X,"^",5),1,2),":",$E($P(X,"^",5),3,4)," ",$$CODES^PSIVUTL($P(X,"^",2),59.51,.02)_" covering ",$P(X,"^",3),"."
11ASK ;
12 S X="Enter manufacturing time(s):^^^^QUX=+QUX!(QUX["","")!(QUX="""")" D ENQ^PSIV Q:X["^"!(X="") S PSM=X F I=1:1 S X=$P(PSM,",",I) Q:X="" I '$D(PSM(X)) S PSM="*" Q
13 I PSM="*" S HELP="ASKMAN" D ^PSIVHLP G P
14SEL F PSIV=1:1 S I=$P(PSM,",",PSIV) Q:I="" S PSIVMT($P(PSM(I),"^",2))=+(PSIVDT_"."_$P(PSM(I),"^",5)),PSIVOD($P(PSM(I),"^",2))=+(PSIVDT_"."_$P(PSM(I),"^")),PSIVCD($P(PSM(I),"^",2))=+(PSIVDT_"."_$P(PSM(I),"^",4)) D SEL1
15 W ! S X=PSM K PSM Q
16SEL1 I $P(PSM(I),"^")>$P(PSM(I),"^",4) S X1=PSIVDT,X2=1 D C^%DTC S X=$P(X,".") S $P(PSIVCD($P(PSM(I),"^",2)),".")=X ; INSTALL WITH V 17.3 OF FILEMAN
17 Q
18ENRSET W ! S X="Are you sure you want to RESET the Ward List (Y/N) ?^N" D ENYN^PSIV Q:"N^"[$E(X) I X="?" S HELP="RESWL" D ^PSIVHLP1 G ENRSET
19 D SELMAN F I=1:1 S Y=$P(X,",",I) Q:'Y S $P(^PS(59.5,PSIVSN,2,Y,0),"^",6)=PSIVDT W !,"... Ward list #",$P(X,",",I)," reset"
20 Q
21PRNT ;
22 D HDR:$Y+7>IOSL!(PSIVWARD'=WRD),INP^VADPT
23 W !,VAIN(5),?30 S PSIV=$O(^PS(55,DFN,"IV",ON,"AD",0)) D:PSIV ENP2^PSIVRNL W ?70 S Y=P(3) D WD W ?92,+^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_+PSIVDT,DFN,ON),?100 W $P($G(^VA(200,+P(6),0)),U)
24 W !,PSIV("NME") S SSNF=0 D ENP3^PSIVRNL Q
25HDR W:$Y @IOF W !,"WARD LIST FOR IV ROOM: ",$P(^PS(59.5,PSIVSN,0),U)," AT " S Y=PSIVDT X ^DD("DD") W $P(Y,"@"),?70,"Printed on : " S Y=PSIVRUN,UWLTY="" X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2) W !
26 F I=0:0 S UWLTY=$O(PSIVOD(UWLTY)) Q:UWLTY="" S X=$$CODES^PSIVUTL(UWLTY,55.01,.04) W !,X,"S",?15," covering from " S Y=PSIVOD(UWLTY) D WD W " to " S Y=PSIVCD(UWLTY) D WD W " Manufacturing time: " S Y=PSIVMT(UWLTY) D WD
27 Q:NOFLG=1 W !!?92,"Qty",!,"Patient name",?40,"Order",?70,"Stop date",?90,"needed",?100,"Provider/Initial"
28 W ! F X=1:1:110 W "-" W:X=50 " Ward: ",WRD," "
29 S PSIVWARD=WRD
30 K UWLTY
31 Q
32SETP S Y=^PS(55,DFN,"IV",ON,0) F X=1:1:23 S P(X)=$P(Y,"^",X)
33 Q
34WD X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2) Q
35CODES S X=$P($P(";"_$P(Y,"^",3),";"_X_":",2),";") Q
36ENT ;
37 ;Will print ward list
38NOW D NOW^%DTC S PSIVRUN=$E(%,1,12),PSIVWARD="" K %,%I,%H
39 S WRD="",NOFLG=1 F JX=0:0 S WRD=$O(^PS(55,"PSIVWL",PSIVSN,WRD)) Q:WRD="" S PSIVT="" F JX=0:0 S PSIVT=$O(PSIVOD(PSIVT)) Q:PSIVT="" S PSIVDT=PSIVOD(PSIVT) D NOW1
40 W:NOFLG !!,"****NO DATA FOUND FOR THE WARD LIST WITH THE SELECTED IV TYPE(S)!****"
41 G QPRNT
42 Q
43NOW1 F DFN=0:0 S DFN=$O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_+PSIVDT,DFN)) Q:'DFN S PSIV("NME")=$P($G(^DPT(DFN,0)),U) D PID^VADPT,NXT
44 Q
45QPRNT K JX,PSIVT,PSIVWARD,PSIVDT,PSIVRUN,WRD Q
46NXT F ON=0:0 S ON=$O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_+PSIVDT,DFN,ON)) Q:'ON S NOFLG=0 D SETP,PRNT:"DPN"'[P(17)
47 Q
48ENINIT ;
49 F Z1=0:0 S Z1=$O(^PS(59.5,PSIVSN,2,Z1)) Q:'Z1 S Z2=^(Z1,0),PSIVT="" F PSIV1=0:0 S PSIVT=$O(PSIVOD(PSIVT)) Q:PSIVT="" I $P(PSIVOD(PSIVT),".",2)=$P(+("."_Z2),".",2),(PSIVT=$P(Z2,"^",2)) S $P(^(0),"^",6)=PSIVOD(PSIVT)\1+("."_$P(^(0),"^"))
50 S Z1="" F PSIV1=0:0 S Z1=$O(^PS(55,"PSIVWL",PSIVSN,Z1)) Q:Z1="" S PSIVT="" F PSIV1=0:0 S PSIVT=$O(^PS(55,"PSIVWL",PSIVSN,Z1,PSIVT)) Q:PSIVT="" D K1
51 K Z1,Z2 Q
52K1 I $E(PSIVT,2,999)<(DT-1) K ^PS(55,"PSIVWL",PSIVSN,Z1,PSIVT),^PS(55,"PSIVWLM",PSIVSN,PSIVT) Q
53 S Z2="" F PSIV1=0:0 S Z2=$O(PSIVOD(Z2)) Q:Z2="" K:PSIVT=(Z2_PSIVOD(Z2)) ^PS(55,"PSIVWL",PSIVSN,Z1,PSIVT),^PS(55,"PSIVWLM",PSIVSN,PSIVT)
54 Q
Note: See TracBrowser for help on using the repository browser.