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

GMTSPSO7.m

Go to the documentation of this file.
  1. GMTSPSO7 ;SLC/JER/KER - OP Rx Summary Component (V7) ;Apr 16, 2021@16:08
  1. ;;2.7;Health Summary;**15,28,37,56,78,80,115**;Oct 20, 1995;Build 190
  1. ;
  1. ; External References
  1. ; DBIA 330 ^PSOHCSUM, ACS^PSOHCSUM
  1. ; DBIA 522 ^PS(55,
  1. ; DBIA 10035 ^DPT( file #2
  1. ; DBIA 3136 ^PS(59.7,
  1. ; DBIA 10011 ^DIWP
  1. ;
  1. MAIN ; OP Rx HS Component
  1. N ECD,GMR,IX,PSOBEGIN,PSOACT,GMX,GMTOP
  1. S PSOBEGIN=$S(GMTS2'=9999999:(9999999-GMTS2),1:"")
  1. I PSOBEGIN="" S PSOACT=1 K PSOBEGIN
  1. K ^TMP("PSOO",$J),^TMP($J,"GMTSPS")
  1. D PROF^PSO52API(DFN,"GMTSPS",1,9999999)
  1. I +$G(^TMP($J,"GMTSPS",DFN,0))<1,'$D(^TMP($J,"GMTSPS",DFN,"ARC")) Q
  1. I '$G(^TMP($J,"GMTSPS",DFN,0)),$D(^TMP($J,"GMTSPS",DFN,"ARC")) D CKP^GMTSUP Q:$D(GMTSQIT) W "Patient Has Archived OP Prescriptions",!
  1. ;I '$D(^PS(55,DFN,"P")),'$D(^("ARC")) Q
  1. ;I '$O(^PS(55,DFN,"P",0)),$D(^PS(55,DFN,"ARC")) D CKP^GMTSUP Q:$D(GMTSQIT) W "Patient Has Archived OP Prescriptions",!
  1. I $L($T(ACS^PSOHCSUM))>0 D ACS^PSOHCSUM I '$D(^TMP("PSOO",$J)) Q
  1. I $L($T(ACS^PSOHCSUM))'>0 D ^PSOHCSUM I '$D(^TMP("PSOO",$J)) Q
  1. S GMTSLO=GMTSLO+3
  1. S (GMTOP,GMX,IX)=0
  1. F S IX=$O(^TMP("PSOO",$J,IX)) Q:IX'>0 S GMR=$G(^(IX,0)) D WRT
  1. S GMTSLO=GMTSLO-3
  1. K ^TMP("PSOO",$J),^UTILITY($J,"W")
  1. Q
  1. WRT ; Writes OP Pharmacy Segment Record
  1. N ID,LFD,X,MI,NL,CF,GMD,GMV,GMI,DIWL,DIWR,DIWF,GMSIG,GUI,IND S GUI=$$HF^GMTSU
  1. S ID=$P(GMR,U),LFD=$P(GMR,U,2),ECD=$P(GMR,U,11),CF=$P(GMR,U,10)
  1. ; Don't display when issue date is after To Date
  1. Q:+$G(GMRANGE)&(ID>(9999999-GMTS1))
  1. F GMV="ID","LFD","ECD" S X=@GMV D REGDT4^GMTSU S @GMV=X K X
  1. S NL=0,DIWL=1,DIWR=73,DIWF="" K ^UTILITY($J,"W")
  1. F S NL=$O(^TMP("PSOO",$J,IX,NL)) Q:NL'>0 D
  1. . S X=$G(^TMP("PSOO",$J,IX,NL,0)) D ^DIWP
  1. S GMD=$P($P(GMR,U,4),";",2)
  1. S IND=$P($G(^TMP("PSOO",$J,IX,"IND")),U)
  1. D CKP^GMTSUP Q:$D(GMTSQIT)
  1. D:GMTSNPG!(GMX'>0) HEAD W:'GMTOP ! S GMTOP=0 W $P($P(GMR,U,3),";",2)
  1. W !,?18,$P(GMR,U,6),?31,$S($G(GMR)["SUSPENDED":"ACTIVE/SUSP",1:$P($P(GMR,U,5),";",2)),?45,$P(GMR,U,7),?54,ID,?65,LFD,?76,"("_$P(GMR,U,8)_")",!
  1. S GMX=1,GMI=0,GMSIG=1
  1. F S GMI=$O(^UTILITY($J,"W",DIWL,GMI)) Q:GMI'>0!$D(GMTSQIT) D
  1. . D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HEAD
  1. . S MI=$G(^UTILITY($J,"W",DIWL,GMI,0))
  1. . W:GMSIG=1 ?2,"SIG: " S:GMSIG=1 GMSIG=0 W ?7,MI,! S GMTOP=0
  1. D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HEAD
  1. W:IND]"" ?4,"Indication: "_IND,! W ?4,"Provider: ",$E(GMD,1,22)
  1. W:CF ?37,"Cost/Fill: $",$J(CF,6,2)
  1. I "EC"[$P($P(GMR,U,5),";"),ECD]"" W ?57,"Exp/Can Dt: "_ECD
  1. W ! S GMTOP=0
  1. Q
  1. ; Only write the next line when there is data
  1. S GMTOP=1
  1. K ^TMP($J,"GMTSPSSYS") D PSS^PSS59P7(1,,"GMTSPSSYS")
  1. I GMX'>0,$D(^DPT(DFN,.1)),^(.1)]"",+$G(^TMP($J,"GMTSPSSYS",1,40.1)) D CKP^GMTSUP Q:$D(GMTSQIT) W "Outpatient prescriptions are cancelled 72 hours after admission",!
  1. ;I GMX'>0,$D(^DPT(DFN,.1)),^(.1)]"",+($P($G(^PS(59.7,1,40.1)),"^")) D CKP^GMTSUP Q:$D(GMTSQIT) W "Outpatient prescriptions are cancelled 72 hours after admission",!
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W !,"Drug....................................",?65,"Last",!
  1. D CKP^GMTSUP Q:$D(GMTSQIT)
  1. W ?18,"Rx #",?31,"Stat",?45,"Qty",?54,"Issued",?65,"Filled",?76,"Rem"
  1. W:$Y'>(IOSL-GMTSLO)!(+($G(GUI))>0) !
  1. Q