Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSGMMIVC

PSGMMIVC.m

Go to the documentation of this file.
  1. PSGMMIVC ;BIR/MV-PRT MULT DAYS MAR C ORDERS(IV) ;16 Mar 99 / 2:10 PM
  1. ;;5.0;INPATIENT MEDICATIONS;**20,21,28,31,35,67,58,110,267**;16 DEC 97;Build 158
  1. ;
  1. ; Reference to ^PS(52.7 supported by DBIA #2173.
  1. ; Reference to ^PS(55 supported by DBIA #2191.
  1. ;
  1. PRT ;*** Print IV orders.
  1. K P,DRG,PSGLRN,PSGMARTS,PSGMARGD,PSGLFFD,TS N ON55,PSJLABEL S TS=1,PSGMARGD="",PSJLABEL=1
  1. S ON=$P(DAO,U,2),DFN=$P(PN,U,2) D:$P(DAO,U,2)["V" GT55^PSIVORFB D:$P(DAO,U,2)["P" GT531^PSIVORFA(DFN,ON) D:P(9)]"" OS S PSGLSSD=P(2),PSGLFFD=P(3)
  1. I $G(P("DTYP"))'=1 K P(11)
  1. F X="LOG",2,3 S:P(X) P(X)=$$ENDTC1^PSGMI(P(X))
  1. D INITOPI
  1. S PSGST=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3)) I PSGST'="O" S PSGST=$S(P(9)["PRN":"P",1:"C")
  1. I PSGST="O",(P(2)="") S PSGST=""
  1. NEW NAMENEED,NEED,X S NAMENEED=0
  1. D LNNEED^PSGMIV,PRTIV
  1. Q
  1. ;
  1. OS ; order record set
  1. S FD=P(3),PSGOES="",X=P(9),SD=P(2) D EN^PSGS0 S T=PSGS0XT
  1. S QQ="" I PST["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:"")
  1. I T="D",P(11)="" S P(11)=$E($P(P(2),".",2)_"0000",1,4)
  1. S PSGMARTS=P(11),PSGMARGD=QQ
  1. K TS D TS^PSGMAR3(P(11))
  1. Q
  1. ;
  1. PRTIV ;*** Print IV order on MAR
  1. I PSGMAROC,(PSGMAROC+LN)>6 D BOT^PSGMMAR2,HEADER^PSGMMAR2
  1. S PSGMAROC=PSGMAROC+1 W !?6,"|",?19,"|",?48,"|",$G(TS(1)) D CELL(1,0)
  1. W !,$E(P("LOG"),1,5)," |"
  1. W:ON["V" $E(P(2),1,5)_$E(P(2),9,14)," |",P(3)
  1. W:ON["P" "P E N D I N G"
  1. W ?39,"("_$E(PSGP(0))_$E(PSSN,8,12)_")"
  1. W ?48,"|",$G(TS(2)) D CELL(2,0) S L=3
  1. NEW NAME
  1. 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 W !,NAME(Y) W:L=3 ?47,PSGST W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)) D L(1)
  1. I '$G(DRG("AD",0)) D
  1. .W !
  1. .W:L=3 ?47,PSGST W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)) D L(1)
  1. W:$G(DRG("SOL",0)) !,"in "
  1. NEW PSJPRT2
  1. F X=0:0 S X=$O(DRG("SOL",X)) Q:'X D NAME^PSIVUTL(DRG("SOL",X),47,.NAME,1) F Y=0:0 S Y=$O(NAME(Y)) Q:'Y D
  1. . W:(Y>1!(X>1)) ! W ?4,NAME(Y) W:L=3 ?47,PSGST W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)) D L(1)
  1. . S PSJPRT2=$P(^PS(52.7,+DRG("SOL",X),0),U,4) I PSJPRT2]"" W !?7,PSJPRT2 W:L=3 ?47,PSGST W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)) D L(1)
  1. W !,$P(P("MR"),U,2)," ",P(9)," ",P(8) W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)) I L>5 S PSJTMPL=L\6,PSJDIV=PSJTMPL+4 I L>PSJDIV,(L#PSJDIV>1) W ! ;I L>5,(L#5>1) W !
  1. I '$G(DRG("SOL",0)) S L=L+1 W !,?48,"|",$G(TS(L)) D CELL(L,'(L#6))
  1. I P(4)="C",'(L#5),P("OPI")="" D
  1. . D L(1)
  1. . W !,"*CAUTION-CHEMOTHERAPY*",?48,"|",$G(TS(L))
  1. . D CELL(L,'(L#6)) W ! ;S L=L+1
  1. E I P(4)="C" D
  1. . D L(1)
  1. . W:L#7=0 !
  1. . W "*CAUTION-CHEMOTHERAPY*",?48,"|",$G(TS(L))
  1. . D CELL(L,'(L#6))
  1. . I (L+1)#6'=0 W !
  1. I (L#5)=0,($L($P(P("OPI"),"^"))<29),(TS<7) S L=L+1
  1. E D L(1)
  1. W:P("OPI")=""&(TS>6) !
  1. I P("OPI")'="",'$$OPI^PSGMIV(PSGP,ON55) D
  1. . I L#7=0 W !
  1. . I L#5=1 W !
  1. . N PSJTMPX S PSJTMPX=0
  1. . F Y=1:1:$L($P(P("OPI"),"^")," ") S Y1=$P($P(P("OPI"),"^")," ",Y) D
  1. .. I $L(Y1)>47 W $E(Y1,1,47)
  1. .. I (PSJTMPX+$L(Y1))>47 W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)),L(1) S PSJTMPX=0 W !
  1. .. I $L(Y1)>47 W $E(Y1,48,$L(Y1)) S PSJTMPX=$L($E(Y1,48,$L(Y1)))
  1. .. E W Y1," " S PSJTMPX=PSJTMPX+$L(Y1)+1
  1. N PSGIVFL I '$O(DRG("AD",0))!'$O(DRG("SOL",0)) S PSGIVFL=1
  1. I L>TS,(L#6) W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)) S L=L+1
  1. I (TS-1)>L W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)) D
  1. . F L=L+1:1:TS-1 D L(0) W !?48,"|",$G(TS(L)) D CELL(L,'(L#6))
  1. . S L=L+1
  1. F Q:'(L#6) W !?48,"|",$G(TS(L)) D CELL(L,'(L#6)) S L=L+1
  1. I '(L#6),(P("OPI")="") W !
  1. I P("OPI")]"",(L>6) W !
  1. W ?29,"RPH: ",PSGLRPH,?38,"RN: ",PSGLRN,?48,"|",$G(TS(L)) D CELL(L,'(L#6)) W:PSGMAROC<6 !?7,LN2
  1. Q
  1. ;
  1. L(X) ;***Check to see if a new block if needed.
  1. S L=L+X
  1. I L#6=0,PSGMAROC<6 D
  1. . W !,"See next label for continuation",?48,"|",$G(TS(L)) D CELL(L,'(L#6))
  1. . W:PSGMAROC<6 !?7,LN2,$C(13) S $X=0 S PSGMAROC=PSGMAROC+1,L=L+1 D
  1. . . I LN>6,(PSGMAROC>5) S MSG1="*** CONTINUE ON NEXT PAGE ***" D BOT^PSGMMAR2,HEADER^PSGMMAR2 S PSGMAROC=1
  1. Q
  1. LN(L) ;*** Print lines within block.
  1. N X S X=$S(L#6:LN4,1:LN7)
  1. Q X
  1. CELL(X,X1) ;
  1. I ON["P",(X=6) NEW PSGLFFD,PSGMARGD S P(9)="",PSGLFFD="9999999",PSGMARGD="" W ?55 D ASTERS^PSGMMAR2 Q
  1. I TS=1,'$G(P(11)),(X=6) W ?55 D ASTERS^PSGMMAR2 Q
  1. I TS=1,'$G(P(11)) W ?55,$$LN(X) Q
  1. D CELL^PSGMMAR2(X,X1)
  1. Q
  1. INITOPI ;* Set nurse's initial and the other print info.
  1. D RPHINIT^PSGMIV(.PSGLRPH)
  1. S PSGLRN="_____"
  1. I ON["V" N ND4 S ND4=$G(^PS(55,DFN,"IV",+ON,4))
  1. I $G(ND4) D
  1. .I $G(DFN),$G(ON) N PSGLREN S PSGLREN=+$$LASTREN^PSJLMPRI(DFN,ON) D
  1. ..N PSGLRNDT S PSGLRNDT=$P(ND4,"^",2),ND4=+ND4 I PSGLRNDT,$G(PSGLREN) I $G(PSGLREN)>PSGLRNDT S ND4=0
  1. .I ND4 D NAME(+ND4,"",.PSGLRN)
  1. I ON["P" D
  1. . 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"
  1. . S PSGST=""
  1. . D NAME(+$G(^PS(53.1,+ON,4)),"",.PSGLRN)
  1. Q
  1. NAME(X,NAME,INIT) ;Lookup in ^VA(200.
  1. ;X = IEN in ^VA(200
  1. ;NAME = Return the name in 200
  1. ;INIT = Return the initial
  1. NEW DIC,Y
  1. S DIC="^VA(200,",DIC(0)="NZ" D ^DIC
  1. S NAME=$G(Y(0,0))
  1. S INIT=$P($G(Y(0)),U,2)
  1. Q