source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJPDV1.m@ 1258

PSJPDV1 ;BIR/KKA-LIST PATIENTS ON SPECIFIC DRUGS (CONT.) ;15 May 98 / 9:28 AM
 ;;5.0; INPATIENT MEDICATIONS ;**3,33,58**;16 DEC 97
 ;
 ; Reference to ^PS(55 supported by DBIA #2191.
 ;
 S PG=1,(PREVNM,TMPNM)="",(PREVWD,TMPWD)="",WFLG=0
REC ;write patient and order information
 D HEADING G:$D(QFLG) DONE
 I '$D(^TMP("PSJ",$J)) W !!,"NO DATA FOUND" G DONE
 S FST="" F  S FST=$O(^TMP("PSJ",$J,FST)) Q:FST=""!($D(QFLG))  S SND="" F  S SND=$O(^TMP("PSJ",$J,FST,SND)) Q:SND=""!($D(QFLG))  S ORD="" F  S ORD=$O(^TMP("PSJ",$J,FST,SND,ORD)) Q:'ORD!($D(QFLG))  D
 .; naked ref below refers to line above
 .S ND=^(ORD),PER=$S(PSJSRT="P":FST,1:SND),STD=$S(PSJSRT="P":SND,1:FST)
 .S WFLG=0,(NM,TMPNM)=$P(PER,";"),(WARD,TMPWD)=$P(ND,"^",2) I PSJSRT="P" S:(TMPNM=PREVNM)&(TMPWD=PREVWD) NM="",WFLG=1 I TMPNM'=PREVNM S PREVNM=NM W !
 .S:TMPWD'=PREVWD PREVWD=WARD S (PSGP,IEN)=$P(PER,";",2),PSJJORD=+ORD D:ORD["V" IVREC Q:$D(QFLG)  D:ORD'["V" UDREC Q:$D(QFLG)
 ;
DONE K ADCNT,CONT,FST,JJ,LCNT,LN,ND3,ND3FLG,ND4,ON,OPI,ORD,P,PER,PG,PREVNM,PEVWD,PRIMD,PSJAD,PSJSOL,RSTFLG,SI,SND,SOLCNT,SSN,TMPNM,TMPWD,WCNT,WFLG,WRD,WARD,RMBD,PSJ,DRGI,DRGN,DRGT
 Q
 ;
UDREC ;write Unit Dose record
 N X,PSJ K ND3FLG
 D DRGDISP^PSJLMUT1(PSGP,PSJJORD_"U",30,30,.PSJ,0)
 S RSTFLG=2,SSN=$P(ND,U),WARD=$P(ND,U,2),RMBD=$P(ND,U,3)
 D:$Y+5>IOSL HEADING Q:$D(QFLG)
 W !!,NM,?32,PSJ(1),?68,$E($$ENDTC^PSGMI(STD),1,5),?75,$E($$ENDTC^PSGMI($P(ND,U,6)),1,5),! W:'WFLG SSN
 N X F X=1:0 S X=$O(PSJ(X)) Q:'X  W ?32,PSJ(X) D THEREST I RSTFLG>3&($X>32) W !
 S WCNT=1,SI=$P($G(^PS(55,PSGP,5,PSJJORD,6)),"^") I SI]"" W:$X>31 ! F  S WRD=$P(SI," ",WCNT) Q:$L(WRD)=0  S WCNT=WCNT+1 D
 .I $X+$L(WRD)>79 W ! I 'WFLG&('$D(ND3FLG)) W $P(ND,"^",3) S ND3FLG=1
 .W ?31," ",WRD
 I 'WFLG&('$D(ND3FLG)) W !,$P(ND,"^",3)
 K ND3FLG
 Q
IVREC ;write IV record
 D:$Y+5>IOSL HEADING Q:$D(QFLG)
 N DRG,P,PSG,ON55,PSJ
 S RSTFLG=1,SSN=$P(ND,U),WARD=$P(ND,U,2),RMBD=$P(ND,U,3)
 S DFN=PSGP,ON=PSJJORD D GT55^PSIVORFB
 W !!,NM
 N X F X=0:0 S X=$O(DRG("AD",X)) Q:'X  D NAME^PSIVUTL(DRG("AD",X),30,.PSJ,1) F JJ=0:0 S JJ=$O(PSJ(JJ)) Q:'JJ  W ?32,PSJ(JJ) D THEREST I RSTFLG>3&($X>32) W !
 N X,PSJ F X=0:0 S X=$O(DRG("SOL",X)) Q:'X  D NAME^PSIVUTL(DRG("SOL",X),30,.PSJ,0) N JJ F JJ=0:0 S JJ=$O(PSJ(JJ)) Q:'JJ  W:JJ=1 ?33,"in " W ?36,PSJ(JJ) D THEREST I RSTFLG>3&($X>31) W !
 W ?32,$P(P("MR"),U,2)_" "_P(9)_" "_P(8) D THEREST
 S OPI=$P(P("OPI"),"^") I OPI]"" W:$X>31 ! F X=1:1:$L(OPI," ") S Y=$P(OPI," ",X) D THEREST W:$X+$L(Y)>80 ! W ?32,Y," "
 F  Q:RSTFLG>3  D THEREST
 Q
THEREST ;
 I RSTFLG=1 W ?68,$E($$ENDTC^PSGMI(STD),1,5),?75,$E($$ENDTC^PSGMI(P(3)),1,5),! W:'WFLG SSN
 I RSTFLG=2 W ! W:'WFLG WARD
 I RSTFLG=3 S ND3FLG=1 W ! W:'WFLG RMBD
 S RSTFLG=RSTFLG+1
 Q
HEADING I $E(IOST)'="P" W !,"Press RETURN to continue ""^"" to exit: " R CONT:DTIME S:CONT["^" QFLG=1 Q:$D(QFLG)
 W:$Y @IOF
 S NM=TMPNM,WFLG=0
 W !,$E($$ENDTC^PSGMI(DT),1,8),?70,"PAGE: ",PG S PG=PG+1
 S LN="LISTING OF PATIENTS WITH ORDERS CONTAINING "_$S(PSJSL="V":"VA CLASS(ES) OF DRUGS",PSJSL="O":"ORDERABLE ITEM(S)",PSJSL="D":"DISPENSE DRUG(S)")_":"
 W !! D LINE W !
 S LN="" F  S LN=$O(PSJSNM(LN)) Q:LN=""  W ! D LINE
 S LN="FROM "_$$ENDTC^PSGMI(PSJREPS)_" TO "_$$ENDTC^PSGMI(PSJREPF) W !! D LINE W !!
 F X=1:1:80 W "-"
 W !?68,"Start",?75,"Stop",!,"Patient",?32,"Order",?68,"Date",?75,"Date",!
 F X=1:1:80 W "-"
 Q
LINE ;    
 W ?(80-$L(LN))/2,LN Q