source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJPDV1.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1PSJPDV1 ;BIR/KKA-LIST PATIENTS ON SPECIFIC DRUGS (CONT.) ;15 May 98 / 9:28 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**3,33,58**;16 DEC 97
3 ;
4 ; Reference to ^PS(55 supported by DBIA #2191.
5 ;
6 S PG=1,(PREVNM,TMPNM)="",(PREVWD,TMPWD)="",WFLG=0
7REC ;write patient and order information
8 D HEADING G:$D(QFLG) DONE
9 I '$D(^TMP("PSJ",$J)) W !!,"NO DATA FOUND" G DONE
10 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
11 .; naked ref below refers to line above
12 .S ND=^(ORD),PER=$S(PSJSRT="P":FST,1:SND),STD=$S(PSJSRT="P":SND,1:FST)
13 .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 !
14 .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)
15 ;
16DONE 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
17 Q
18 ;
19UDREC ;write Unit Dose record
20 N X,PSJ K ND3FLG
21 D DRGDISP^PSJLMUT1(PSGP,PSJJORD_"U",30,30,.PSJ,0)
22 S RSTFLG=2,SSN=$P(ND,U),WARD=$P(ND,U,2),RMBD=$P(ND,U,3)
23 D:$Y+5>IOSL HEADING Q:$D(QFLG)
24 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
25 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 !
26 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
27 .I $X+$L(WRD)>79 W ! I 'WFLG&('$D(ND3FLG)) W $P(ND,"^",3) S ND3FLG=1
28 .W ?31," ",WRD
29 I 'WFLG&('$D(ND3FLG)) W !,$P(ND,"^",3)
30 K ND3FLG
31 Q
32IVREC ;write IV record
33 D:$Y+5>IOSL HEADING Q:$D(QFLG)
34 N DRG,P,PSG,ON55,PSJ
35 S RSTFLG=1,SSN=$P(ND,U),WARD=$P(ND,U,2),RMBD=$P(ND,U,3)
36 S DFN=PSGP,ON=PSJJORD D GT55^PSIVORFB
37 W !!,NM
38 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 !
39 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 !
40 W ?32,$P(P("MR"),U,2)_" "_P(9)_" "_P(8) D THEREST
41 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," "
42 F Q:RSTFLG>3 D THEREST
43 Q
44THEREST ;
45 I RSTFLG=1 W ?68,$E($$ENDTC^PSGMI(STD),1,5),?75,$E($$ENDTC^PSGMI(P(3)),1,5),! W:'WFLG SSN
46 I RSTFLG=2 W ! W:'WFLG WARD
47 I RSTFLG=3 S ND3FLG=1 W ! W:'WFLG RMBD
48 S RSTFLG=RSTFLG+1
49 Q
50HEADING I $E(IOST)'="P" W !,"Press RETURN to continue ""^"" to exit: " R CONT:DTIME S:CONT["^" QFLG=1 Q:$D(QFLG)
51 W:$Y @IOF
52 S NM=TMPNM,WFLG=0
53 W !,$E($$ENDTC^PSGMI(DT),1,8),?70,"PAGE: ",PG S PG=PG+1
54 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)")_":"
55 W !! D LINE W !
56 S LN="" F S LN=$O(PSJSNM(LN)) Q:LN="" W ! D LINE
57 S LN="FROM "_$$ENDTC^PSGMI(PSJREPS)_" TO "_$$ENDTC^PSGMI(PSJREPF) W !! D LINE W !!
58 F X=1:1:80 W "-"
59 W !?68,"Start",?75,"Stop",!,"Patient",?32,"Order",?68,"Date",?75,"Date",!
60 F X=1:1:80 W "-"
61 Q
62LINE ;
63 W ?(80-$L(LN))/2,LN Q
Note: See TracBrowser for help on using the repository browser.