Changeset 636 for FOIAVistA/tag/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGPLR.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGPLR.m (modified) (3 diffs)

FOIAVistA/tag/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGPLR.m

@@ -1 @@
-PSGPLR ;BIR/CML3-PRINTS PICK LIST REPORT ; 6/15/07 1:12pm
- ;;5.0; INPATIENT MEDICATIONS ;**10,50,67,119,129,191**;16 DEC 97;Build 9
+PSGPLR ;BIR/CML3-PRINTS PICK LIST REPORT ;04 May 98 / 11:23 AM
+ ;;5.0; INPATIENT MEDICATIONS ;**10,50,67,119,129**;16 DEC 97
  ;
  ; Reference to ^PS(55 is supported by DBIA# 2191.
@@ -31 +31 @@
  .N OSTOP,DRGND S (DDRG,OLDWARD)="" S DRGND=$O(PSGPLREN("B",PSGP,PSJJORD,0)) Q:'DRGND  S OSTOP=PSGPLREN("B",PSGP,PSJJORD,DRGND) Q:'OSTOP
  .N ST,TMPDRG S CNT=0,ST=$P(ND0,"^",7) S TMPDRG=0 S TMPDRG=$O(PSGPLREN("B",PSGP,PSJJORD,TMPDRG)) S TMPDRG=$P(DRG,"^")_"^"_TMPDRG
- .F PSGPLXRX="AU","AC" Q:CNT  F I=0:1 S DDRG=$O(PSGPLREN(53.5,PSGPLXRX,PSGPLG,TM,WDN,RM,PN,PST,TMPDRG,DDRG)) Q:(DDRG="")!(DDRG="NO DISPENSE DRUG")  D
+ .F PSGPLXRX="AU","AC" Q:CNT  F  S DDRG=$O(PSGPLREN(53.5,PSGPLXRX,PSGPLG,TM,WDN,RM,PN,PST,TMPDRG,DDRG)) Q:(DDRG="")!(DDRG="NO DISPENSE DRUG")  D
  ..S X=$G(PSGPLREN(53.5,PSGPLG,1,PSGP,1,+DRGND,1,$P(DDRG,"^",2),0)) S DR=+X,DND=$P(X,U,2,4) Q:'X
  ..S DRN=$G(^PS(55,PSGP,5,PSJJORD,1,DR,0)),DR=$$ENDDN^PSGMI($P(DRN,"^")) I DND?7N1"DI" S DND=$E($$ENDTC^PSGMI(+DND),1,8)
  ..S DIS=$P(DND,"^",2),NEED=$S($P(DND,"^")]"":$P(DND,"^"),1:0)
- ..;GMZ;PSJ*5*191;Allow for Multiple Dispensed Drug units needed
- ..S PSJRNW(I)=1_"^"_+NEED
+ ..S PSJRNW=1_"^"_+NEED
  ..Q
  .K PSGPLREN("B",PSGP,PSJJORD),PSGPLREN(53.5,PSGPLG,1,PSGP,1,+DRGND) W !!
@@ -47 +46 @@
  .I ATC S X=0,X=$O(^PS(59.7,X)) I $P($G(^(X,26)),U,2)=1,PST="OC" S ATC=0
  .S UD=$S('UD:1,UD=.5:"1/2",UD=.25:"1/4",UD<1:"0"_UD,1:UD)
- .I $D(PSJRNW) D
- ..I 'CNT W !?35,"**** RENEWAL ****"
- ..S NEED=NEED-$P(PSJRNW(CNT),"^",2) S:NEED<0 NEED=0 S CNT=CNT+1
+ .I $G(PSJRNW),'CNT W !?35,"**** RENEWAL ****" S CNT=CNT+1,NEED=NEED-$P(PSJRNW,"^",2) S:NEED<0 NEED=0
  .W !?6,DR,?48,ST W:(ATC)&(NEED>0) ?57,"ATC" W ?61,$J(UD,4),?68,$J(NEED,4),?75,$S(DIS]"":$J(DIS,4),1:"____")
  .S:ST="DISCONTINUED" OLDWARD=1 S ST=""