| [613] | 1 | PSJEXP0 ;BIR/CML3,KKA-PRINTS MEDICATION EXPIRATION NOTICES ;13 FEB 96 / 10:04 AM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**50,58**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^PS(55 is supported by DBIA# 2191.
|
|---|
| 5 | ;
|
|---|
| 6 | D NOW^%DTC S PSGDT=%,PSGOD=$$ENDTC^PSGMI(PSGDT) U IO
|
|---|
| 7 | I '$D(^TMP("PSG",$J)) W:IO'=(IO(0)!(IOST'["C-"))&($Y) @IOF W !!," AS OF ",PSGOD,!,"NO EXPIRED ORDERS FROM ",PSGEXPS," THROUGH ",PSGEXPF,!,"FOR ",$S(PSGSS="P":"PATIENT",PSGSS="W":"WARD",1:"WARD GROUP"),": ",PSJMSG,"." G DONE
|
|---|
| 8 | S PSGPDT=PSGOD,(BLF,LINE,PSSN,Q,TM,WDN,RB,PN)="",PG=0,$P(LINE,"-",81)="" K PSJDLW
|
|---|
| 9 | F S TM=$O(^TMP("PSG",$J,TM)) Q:TM=""!$G(PSJDLW) F S WDN=$O(^TMP("PSG",$J,TM,WDN)) Q:WDN=""!$G(PSJDLW) F S RB=$O(^TMP("PSG",$J,TM,WDN,RB)) Q:RB=""!$G(PSJDLW) D STRT1
|
|---|
| 10 | S Q=1 D:'$G(PSJDLW) NP
|
|---|
| 11 | ;
|
|---|
| 12 | DONE ;
|
|---|
| 13 | W:(IO'=IO(0)!(IOST'["C-"))&($Y) @IOF K AD,BLF,DX,LINE,OPN,PSJORB,OSSN,OTM,OWDN,PAGE,PDOB,PG,PN,PRB,PSD,PSGPDT,PSSN,PST,PTM,PWDN,RCT,Q1,RB,TD,WDRG
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | STRT1 ;
|
|---|
| 17 | F S PN=$O(^TMP("PSG",$J,TM,WDN,RB,PN)) Q:PN=""!$G(PSJDLW) S ND=^(PN) D INFO F SD=0:0 S SD=$O(^TMP("PSG",$J,TM,WDN,RB,PN,SD)) Q:'SD!$G(PSJDLW) D PRT
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | PRT ;
|
|---|
| 21 | S PSD=$$ENDTC^PSGMI(SD)
|
|---|
| 22 | F PST="C","O","OC","P","R" S DRG="" F S DRG=$O(^TMP("PSG",$J,TM,WDN,RB,PN,SD,PST,DRG)) Q:DRG=""!$G(PSJDLW) S ND=^(DRG),PSJJORD=$P(DRG,"^",2) D:$Y+6>IOSL NP I '$G(PSJDLW) D:PSJJORD'["V" WREC I PSJJORD["V" S PSJJORD=$P(PSJJORD,"V") D WRECIV
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | INFO ;
|
|---|
| 26 | S PSGP=$P(PN,"^",2),PTM=$P(ND,"^"),PWDN=$P(ND,"^",2),PRB=$P(ND,"^",3),PPN=$P(ND,"^",4) S:PPN=PSGP PPN=PPN_";DPT(" F X="PTM","PWDN","PRB" I @X="zz" S @X="*NF*"
|
|---|
| 27 | S PSEX=$P(ND,"^",5),PDOB=$P(ND,"^",6),PSSN=$P(ND,"^",7),DX=$P(ND,"^",8),WT=$P(ND,"^",9),AD=$P(ND,"^",10),TD=$P(ND,"^",11),PAGE=$S($P(PDOB,";",2):$P(PDOB,";",2),1:"?"),PDOB=$P(PDOB,";") S:PSEX="" PSEX="*NF*"
|
|---|
| 28 | F X="PDOB","AD","TD" S @X=$E(@X,1,8)
|
|---|
| 29 | ;
|
|---|
| 30 | NP ; last line and heading for next page
|
|---|
| 31 | G:'BLF HEADER F Q1=$Y:1:(IOSL-4) W !
|
|---|
| 32 | W !?5,OPN,?37,OSSN,?51,OWDN,?68,PSJORB Q:Q
|
|---|
| 33 | ;
|
|---|
| 34 | HEADER ;
|
|---|
| 35 | I IOST["C-" K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S PSJDLW=1 Q
|
|---|
| 36 | S PG=PG+1 W:$Y @IOF W !," AS OF: ",PSGPDT,?73-$L(PG),"Page: ",PG,!!!,?20,"THE FOLLOWING MEDICATIONS WILL EXPIRE",!?17,"FROM ",PSGEXPS," THROUGH ",PSGEXPF,!?10,"TO CONTINUE MEDICATIONS, PLEASE REORDER ON VA FORM 10-1158.",!!
|
|---|
| 37 | S:$D(PSJSEL("TM")) TEAM=TM D ENTRY^PSJHEAD(PSGP,"",PG,"","")
|
|---|
| 38 | ;W !!?1,PPN,?36,"Ward: "_PWDN
|
|---|
| 39 | ;W !?7,"PID: "_PSSN,?30,"Weight(kg): "_WT,?61,"Admitted: ",AD
|
|---|
| 40 | ;W !?7,"DOB: "_PDOB_" ("_PAGE_")",?37,"Sex: "_PSEX W:TD ?53,"Last transferred: ",TD
|
|---|
| 41 | ;W !?8,"Dx: "_$S(DX]"":DX,1:"*NF*"),?$S($L(PRB)<9:61,1:69-$L(PRB)),"Room-Bed: ",PRB,!?1,"Reactions:" D ENRCT^PSGAPP
|
|---|
| 42 | W !!?1,"Medication",?42,"ST",?45,"Start",?52,"Stop",?67,"Status/Info",!?3,"Dosage",?67,"Provider",!,LINE S BLF=1,OPN=PPN,PSJORB=PRB,OSSN=PSSN,OTM=PTM,OWDN=$E(PWDN,1,16) Q
|
|---|
| 43 | ;
|
|---|
| 44 | WREC ; write Unit Dose record here
|
|---|
| 45 | N X,PSG
|
|---|
| 46 | D DRGDISP^PSJLMUT1(+PSGP,+PSJJORD_"U",39,39,.PSG,0)
|
|---|
| 47 | S PSGOD=$$ENDTC^PSGMI($P(ND,"^",2)) W !!?1,PSG(1),?42,PST,?45,$E(PSGOD,1,5)_" "_PSD,?67,$P(ND,"^",4) I $P(ND,"^",8) W ?70,$E("HSM",$P(ND,"^",8),3)
|
|---|
| 48 | ;W !?1,PSG(2),?79-$L($P(ND,"^",5)),$P(ND,"^",5)
|
|---|
| 49 | N MARX D TXT^PSGMUTL($P(ND,"^",5),24)
|
|---|
| 50 | N DLINS,LN S DLINS=$O(PSG(""),-1)
|
|---|
| 51 | F LN=2:1:$S(MARX-1>DLINS:MARX,1:DLINS+1) D
|
|---|
| 52 | .W !,$G(PSG(LN)),?55,$G(MARX(LN-1))
|
|---|
| 53 | ;N X F X=2:0 S X=$O(PSG(X)) Q:'X W !?1,PSG(X)
|
|---|
| 54 | ;S WCNT=1,SI=$G(^PS(55,PSGP,5,PSJJORD,6)) I SI]"" W ! F S WRD=$P(SI," ",WCNT) Q:$L(WRD)=0 S WCNT=WCNT+1 W:$X+$L(WRD)>80 ! W " ",WRD
|
|---|
| 55 | S SI=$P($G(^PS(55,PSGP,5,PSJJORD,6)),"^") I SI]"" W !?5,"Special Instructions: " F X=1:1:$L(SI," ") S Y=$P(SI," ",X) W:$X+$L(Y)>78 !?28 W Y," "
|
|---|
| 56 | Q
|
|---|
| 57 | WRECIV ; write IV record here
|
|---|
| 58 | N DRG,P,ON55,PSG
|
|---|
| 59 | S (FSTFLG,SNDFLG,LNCNT)=0
|
|---|
| 60 | S PSGOD=$$ENDTC^PSGMI($P(ND,"^",2))
|
|---|
| 61 | S DFN=PSGP,ON=+PSJJORD D GT55^PSIVORFB W !
|
|---|
| 62 | N X F X=0:0 S X=$O(DRG("AD",X)) Q:'X D NAME^PSIVUTL(DRG("AD",X),39,.PSG,1) F JJ=0:0 S JJ=$O(PSG(JJ)) Q:'JJ W !?1,PSG(JJ) S LNCNT=LNCNT+1 D:LNCNT=1 FST D:LNCNT=2 SND
|
|---|
| 63 | N X,PSG,JJ F X=0:0 S X=$O(DRG("SOL",X)) Q:'X D NAME^PSIVUTL(DRG("SOL",X),33,.PSG,0) F JJ=0:0 S JJ=$O(PSG(JJ)) Q:'JJ W ! W:JJ=1 ?3,"in" W ?6,PSG(JJ) S LNCNT=LNCNT+1 D:LNCNT=1 FST D:LNCNT=2 SND
|
|---|
| 64 | W !?1,$P(P("MR"),U,2)_" "_P(9)_" "_P(8) D:'FSTFLG FST I FSTFLG&('SNDFLG) W ! D SND
|
|---|
| 65 | S OPI=$P(P("OPI"),"^") I OPI]"" W !?5,"Other Print Info: " F X=1:1:$L(OPI," ") S Y=$P(OPI," ",X) W:$X+$L(Y)>78 !?28 W Y," "
|
|---|
| 66 | Q
|
|---|
| 67 | FST S FSTFLG=1 W ?42,PST,?45,$E(PSGOD,1,5)_" "_PSD,?67,P(17)
|
|---|
| 68 | Q
|
|---|
| 69 | SND S SNDFLG=1 W ?79-$L($P(P(6),U,2)),$P(P(6),U,2) Q
|
|---|
| 70 | LIST ;**list IV orders, UD orders, or ALL
|
|---|
| 71 | K DTOUT,DUOUT,DIR W ! S DIR(0)="SOAM^IV:IV;UD:Unit Dose;A:ALL",DIR("A")="List IV orders, Unit Dose orders, or All orders: ",DIR("B")="ALL",DIR("?")="Please enter a code."
|
|---|
| 72 | S DIR("?",1)="Enter ""IV"" to see only IV orders, ""UD"" to see only Unit",DIR("?",2)="Dose orders, or ""A"" to see both IV and Unit Dose orders." D ^DIR K DIR S:$D(DTOUT)!($D(DUOUT)) OUT=1 S CHOICE=Y
|
|---|
| 73 | Q
|
|---|
