source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJORMA2.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1PSJORMA2 ;BIR/MV-COLLECT DATA FOR ACTIVE IV AND FLUID PENDINGS ;19 Mar 99 / 10:20 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**2,15,21,26,58**;16 DEC 97
3 ;
4 ; References to ^PS(52.7 supported by DBIA #2173
5 ; References to ^PS(55 supported by DBIA #2191
6 ; Reference to SETSTR^VALM1 supported by DBIA #10116
7 ;
8PRT ;Get IV nodes.
9 K P,DRG,PSGLRN,PSGMARTS,PSGMARGD,PSGLFFD,TS N ON55 S TS=1,PSGMARGD=""
10 I ON["V" D GT55^PSIVORFB
11 I ON["P" D GT531^PSIVORFA(DFN,ON)
12 I $G(ACT)="NW" D
13 .S P("OLDON")=$S(ON["P":$P($G(^PS(53.1,+ON,0)),U,25),1:$P($G(^PS(55,DFN,"IV",+ON,2)),U,5))
14 .I $G(P("OLDON"))]"" S PSJROC=$S(P("OLDON")["V":$P(^PS(55,DFN,"IV",+P("OLDON"),2),U,8),1:$P(^PS(53.1,+P("OLDON"),0),U,27)),PSJF=$S(P("OLDON")["V":"^PS(55,"_DFN_",""IV"","_+P("OLDON"),1:"^PS(53.1,"_+P("OLDON")) D
15 ..S $P(@(PSJF_",7)"),U,1,2)=PSJLDT_"^"_$S(PSJROC="R":"R",1:"DE")
16 S PSJF=$S(ON["V":"^PS(55,"_DFN_",""IV"","_+ON,1:"^PS(53.1,"_+ON)
17 I $G(ACT)]""&($G(ACT)'="NW") S $P(@(PSJF_",7)"),U,1,2)=PSJLDT_"^"_$S(ACT="DC":"D",ACT="HD":"H1",1:"H0")
18 S PSGLR=$S(ON["P":$P($G(^PS(53.1,+ON,7)),U,2),1:$P($G(^PS(55,DFN,"IV",+ON,7)),U,2))
19 S (PST,PSGST)=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3)) I PST="" S (PST,PSGST)=$S(P(9)["PRN":"P",P(2)=P(3):"O",1:"C")
20 D:P(9)]"" OS S PSGLSD=P(2),PSGLFD=P(3)
21 F X="LOG",2 S:P(X) P(X)=$$ENDTC1^PSGMI(P(X))
22 D INITOPI
23 I PSGST="O",(P(2)="") S PSGST=""
24 NEW NAMENEED,NEED,X S NAMENEED=0
25 ;D LNNEED^PSGMIV,PRTIV
26 D PRTIV
27 Q
28 ;
29OS ; Define admin times.
30 ;* S FD=P(3),PSGOES="",X=P(9),SD=P(2) D EN^PSGS0 S T=PSGS0XT
31 S (FD,PSGMARFD)=P(3),PSGOES="",X=P(9),(SD,PSGMARSD)=P(2) D EN^PSGS0 S T=PSGS0XT
32 S QQ="" I PSGST["C" D DTS^PSGMMAR0(P(9)) S SD=$P(SD,"."),QQ="" F X=0:0 S X=$O(PSGD(X)) Q:'X S QQ=QQ_$S(X<SD:"",X>FD:"",'S:$P(PSGD(X),U),$D(S(X)):$P(PSGD(X),U),1:"")
33 K PSGMARFD,PSGMARSD
34 I T="D",P(11)="" S P(11)=$E($P(P(2),".",2)_"0000",1,4)
35 S PSGMARTS=P(11),PSGMARGD=QQ
36 K TS D TS^PSGMAR3(P(11))
37 Q
38 ;
39PRTIV ; Set up order info on IV label.
40 S MARLB(1)=$E(P("LOG"),1,5)_" |"
41 I ON["P",+$G(^PS(53.1,+ON,4)) S MARLB(1)=MARLB(1)_"P E N D I N G"
42 E S MARLB(1)=MARLB(1)_$E(P(2),1,5)_$E(P(2),9,14),X=$S(ON["P":"",P(3)=1:"********",1:$$ENDTC1^PSGMI(P(3))),MARLB(1)=$$SETSTR^VALM1(" |"_X,MARLB(1),19,16)
43 S MARLB(1)=$$SETSTR^VALM1("("_PSGLBS5_")",MARLB(1),36,7)
44 NEW NAME S L=2
45 F X=0:0 S X=$O(DRG("AD",X)) Q:'X D NAME^PSIVUTL(DRG("AD",X),47,.NAME,1) F Y=0:0 S Y=$O(NAME(Y)) Q:'Y D
46 . S MARLB(L)=NAME(Y) S:L=2 MARLB(L)=$$SETSTR^VALM1(PSGST,MARLB(L),42,1) D L(1)
47 S:$G(DRG("SOL",0)) MARLB(L)="in " NEW PSJPRT2
48 F X=0:0 S X=$O(DRG("SOL",X)) Q:'X D NAME^PSIVUTL(DRG("SOL",X),47,.NAME,1) D
49 . F Y=0:0 S Y=$O(NAME(Y)) Q:'Y S:(Y>1) L=L+1 S MARLB(L)=$$SETSTR^VALM1(NAME(Y),$G(MARLB(L)),4,$L(NAME(Y))) D L(1)
50 . S PSJPRT2=$P(^PS(52.7,+DRG("SOL",X),0),U,4) I PSJPRT2]"" S:(Y>1) L=L+1 S MARLB(L)=" "_PSJPRT2 D L(1)
51 S MARLB(L)=$P(P("MR"),U,2)_" "_P(9)_" "_P(8)
52 ;I P(4)="C",'(L#4),P("OPI")="" S L=L+1,MARLB(L)=$G(MARLB(L))_"*CAUTION-CHEMOTHERAPY*" S L=L+1 Q
53 I P(4)="C",'(L#4),P("OPI")="" D L(1) S MARLB(L)=$G(MARLB(L))_"*CAUTION-CHEMOTHERAPY*" D L(1)
54 I P(4)'="C",(P("OPI")="") S L=L+1
55 I P("OPI")'="" D L(1) D
56 . F Y=1:1:$L($P(P("OPI"),"^")," ") D:$L($G(MARLB(L)))>42 L(1) S MARLB(L)=$G(MARLB(L))_$P($P(P("OPI"),"^")," ",Y)_" "
57 . S L=L+1
58 I (L#5)>0 S X=0 F Q:X D
59 . D L(0) S MARLB(L)="",L=L+1
60 . I TS,(L>TS),'(L#5) S X=1 Q
61 . I TS=0,'(L#5) S X=1 Q
62 S MARLB(L)=$$SETSTR^VALM1("RPH: "_PSGLRPH,$G(MARLB(L)),23,10)
63 S MARLB(L)=$$SETSTR^VALM1("RN: "_PSGLRN,$G(MARLB(L)),33,9)
64 Q
65 ;
66L(X) ;***Check to see if a new block if needed.
67 S L=L+X
68 I L#5=0 S MARLB(L)="See next label for continuation",L=L+1
69 Q
70INITOPI ;* Set nurse's initial and the other print info.
71 D RPHINIT^PSGMIV(.PSGLRPH)
72 S PSGLRN="_____"
73 S:ON["P" PSGLRN=+$G(^PS(53.1,+ON,4)) S:ON["V" PSGLRN=+$G(^PS(55,DFN,"IV",+ON,4))
74 I PSGLRN,$D(^VA(200,+PSGLRN,0))#2 S X=^(0),X=$S($P(X,"^",2)]"":$P(X,"^",2),1:$P(X,"^")),PSGLRN=$S(X'[",":X,1:$E(X,$F(X,","))_$E(X))
75 S:$G(PSGLRN)=0 PSGLRN="_____"
76 I ON["P" D
77 . I P("OPI")="",$O(^PS(53.1,+ON,12,0)) S X=0 F S X=$O(^PS(53.1,+ON,12,X)) Q:'X S Z=$G(^(X,0)),Y=$L(P("OPI")) S:Y+$L(Z)'>179 P("OPI")=P("OPI")_Z_" " I Y+$L(Z)>179 S P("OPI")="SEE PROVIDER COMMENTS"
78 . S PSGST=""
79 Q
Note: See TracBrowser for help on using the repository browser.