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

PSGEUDP.m

Go to the documentation of this file.
  1. PSGEUDP ;BIR/MV-PRINT EXTRA UNITS DISP. ;04 JAN 95 / 12:27 PM
  1. ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
  1. START ;
  1. ;*** The drug name will be truncated to 33 chars when print
  1. ;*** by Ward/WardGroup
  1. I '$D(^TMP($J)) W !!,"NO DATA FOUND ON EXTRA UNITS DISPENSED" G EXIT
  1. U IO
  1. NEW MSG1,MSG2,DRGO,PPNO,TMO,PNAME
  1. S (PSGPG,PSJSTOP)=0
  1. S MSG1="TOTAL FOR ",$P(MSG2,".",80)="."
  1. D @($S(PSGSS="P":"P",1:"W"))
  1. EXIT D EXITDEV^PSJMUTL
  1. K PSGTOTD,PSGTOTM,PSGTOTU,PSGTOTW,PSGWNO,PSGPG
  1. Q
  1. ;
  1. P ;*** Print by patient.
  1. S (PPNO,DRGO)=""
  1. S (PPN,DRG)="" F S PPN=$O(^TMP($J,PPN)) Q:(PPN=""!$G(PSJSTOP)) S PNAME=$P($G(^DPT($P(PPN,"^",2),0)),"^") F S DRG=$O(^TMP($J,PPN,DRG)) Q:(DRG=""!$G(PSJSTOP)) D
  1. . F PSGDT=0:0 S PSGDT=$O(^TMP($J,PPN,DRG,PSGDT)) Q:('PSGDT!$G(PSJSTOP)) D PRTPT
  1. Q:$G(PSJSTOP)
  1. D:DRGO]"" TOT(PSGTOTD," ",46),TOT(PSGTOTU,MSG1_$P($G(^DPT($P(PPNO,"^",2),0)),"^"),46)
  1. Q
  1. ;
  1. PRTPT ;*** Print Extra Dispensed Drug sort by patient.
  1. S ND=^TMP($J,PPN,DRG,PSGDT)
  1. I PPN'=PPNO D:DRGO]"" TOT(PSGTOTD," ",46) D:PPNO]"" TOT(PSGTOTU,MSG1_$P($G(^DPT($P(PPNO,"^",2),0)),"^"),46) D PHDR S PSGTOTU=0,PPNO=PPN,DRGO=""
  1. I DRG'=DRGO D:DRGO]"" TOT(PSGTOTD," ",46) W !,DRG S DRGO=DRG,PSGTOTD=0
  1. E W !
  1. W ?46,$J(+ND,5),?53,$$ENDTC^PSGMI(PSGDT),?69,$E($P(^VA(200,+$P(ND,U,2),0),U,2),1,4)
  1. D:($Y+5)>IOSL PHDR
  1. S PSGTOTD=PSGTOTD+(+ND),PSGTOTU=PSGTOTU+(+ND)
  1. Q
  1. ;
  1. TOT(TOT,NAME,X) ;*** Print the total line for drug,patient,team,ward...
  1. W !?2,NAME,$E(MSG2,1,X-2-$L(NAME)),?X,$J(TOT,5),!
  1. Q
  1. ;
  1. PHDR ;*** Print the header when sort by patient.
  1. D HDR Q:$G(PSJSTOP)
  1. W !!,PNAME,?39,"Room_Bed: "_$P(ND,U,4),!,$P(ND,U,3),?39," Ward: "_$P(ND,U,5),!
  1. W !!,"DRUG NAME",?47,"UNIT",?53,"DATE",?69,"DISP."
  1. W !?53,"DISPENSED",?69,"BY",!
  1. Q
  1. HDR ;*** Print the report main header.
  1. Q:$$PRTCHK^PSJMUTL(PSGPG)
  1. S PSGPG=PSGPG+1 W:$Y @IOF
  1. W !?30,"EXTRA UNITS DISPENSED REPORT",?68,"PAGE: ",PSGPG
  1. W !?17,"REPORT FROM: ",$$ENDTC^PSGMI(PSGSDT)," TO: ",$$ENDTC^PSGMI(PSGEDT),!
  1. Q
  1. W ;***Print by ward/ward group.
  1. S (DRGO,PSGWN,PSGWNO,TMO)="",(PSGTOTD,PSGTOTM,PSGTOTU,PSGTOTW)=0
  1. F S PSGWN=$O(^TMP($J,PSGWN)) Q:(PSGWN=""!$G(PSJSTOP)) S TM="" F S TM=$O(^TMP($J,PSGWN,TM)) Q:(TM=""!$G(PSJSTOP)) D
  1. . S DRG="" F S DRG=$O(^TMP($J,PSGWN,TM,DRG)) Q:(DRG=""!$G(PSJSTOP)) S PPN="" F S PPN=$O(^TMP($J,PSGWN,TM,DRG,PPN)) Q:(PPN=""!$G(PSJSTOP)) S PNAME=$P($G(^DPT($P(PPN,"^",2),0)),"^") D
  1. . . F PSGDT=0:0 S PSGDT=$O(^TMP($J,PSGWN,TM,DRG,PPN,PSGDT)) Q:('PSGDT!$G(PSJSTOP)) D PRTW
  1. Q:$G(PSJSTOP)
  1. D:PSGTOTD TOT(PSGTOTD," ",53) D:TMO]""&(PSGTOTM&($G(PSGTM)!$G(PSGTMALL))) TOT(PSGTOTM,MSG1_TMO,53) D:PSGTOTW TOT(PSGTOTW,MSG1_PSGWNO,53) D:$G(PSGWGNM)]"" TOT(PSGTOTU,MSG1_PSGWGNM,53)
  1. Q
  1. ;
  1. PRTW ;*** Print output for ward/ward group
  1. S ND=^TMP($J,PSGWN,TM,DRG,PPN,PSGDT)
  1. D:'PSGPG WHDR
  1. I PSGWN'=PSGWNO D
  1. . D:DRGO]"" TOT(PSGTOTD," ",53) D:TMO]""&($G(PSGTM)!$G(PSGTMALL)) TOT(PSGTOTM,MSG1_TMO,53) D:PSGWNO]"" TOT(PSGTOTW,MSG1_PSGWNO,53)
  1. . W !,"WARD: ",PSGWN W:$G(PSGTM)!$G(PSGTMALL) !,"TEAM: ",TM
  1. . S DRGO="",TMO=TM,PSGWNO=PSGWN,(PSGTOTD,PSGTOTM,PSGTOTW)=0
  1. I ($G(PSGTM)!$G(PSGTMALL)),TM'=TMO D:DRGO]"" TOT(PSGTOTD," ",53) D:TMO]"" TOT(PSGTOTM,MSG1_TMO,53) W !,"TEAM: ",TM S TMO=TM,DRGO="",(PSGTOTD,PSGTOTM)=0
  1. I DRG'=DRGO D:DRGO]"" TOT(PSGTOTD," ",53) W !!,$E(DRG,1,31) S DRGO=DRG,PSGTOTD=0
  1. E W !
  1. W ?33,$E(PNAME,1,13)_"("_$P(ND,U,3)_")",?53,$J(+ND,5),?59,$$ENDTC^PSGMI(PSGDT),?75,$E($P(^VA(200,+$P(ND,U,2),0),U,2),1,4)
  1. D:($Y+5)>IOSL WHDR
  1. S PSGTOTD=PSGTOTD+(+ND),PSGTOTU=PSGTOTU+(+ND),PSGTOTM=PSGTOTM+(+ND),PSGTOTW=PSGTOTW+(+ND)
  1. Q
  1. ;
  1. WHDR ;***Print ward/ward group header
  1. D HDR
  1. Q:$G(PSJSTOP)
  1. W !!,"DRUG NAME",?33,"PATIENT",?54,"UNIT",?59,"DATE",?75,"DISP.",!,?59,"DISPENSED",?75,"BY",!
  1. F X=1:1:80 W "="
  1. W !
  1. Q
  1. ;