Changeset 623 for WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSPSO7.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSPSO7.m
r613 r623 1 GMTSPSO7 ; SLC/JER/KER - OP Rx Summary Component (V7) ; 08/27/2002 2 ;;2.7;Health Summary;**15,28,37,56,78,80**;Oct 20, 1995;Build 9 3 ; 4 ; External References 5 ; DBIA 330 ^PSOHCSUM, ACS^PSOHCSUM 6 ; DBIA 522 ^PS(55, 7 ; DBIA 10035 ^DPT( file #2 8 ; DBIA 3136 ^PS(59.7, 9 ; DBIA 10011 ^DIWP 10 ; 11 MAIN ; OP Rx HS Component 12 N ECD,GMR,IX,PSOBEGIN,PSOACT,GMX,GMTOP 13 S PSOBEGIN=$S(GMTS2'=9999999:(9999999-GMTS2),1:"") 14 I PSOBEGIN="" S PSOACT=1 K PSOBEGIN 15 K ^TMP("PSOO",$J),^TMP($J,"GMTSPS") 16 D PROF^PSO52API(DFN,"GMTSPS",1,9999999) 17 I +$G(^TMP($J,"GMTSPS",DFN,0))<1,'$D(^TMP($J,"GMTSPS",DFN,"ARC")) Q 18 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",! 19 ;I '$D(^PS(55,DFN,"P")),'$D(^("ARC")) Q 20 ;I '$O(^PS(55,DFN,"P",0)),$D(^PS(55,DFN,"ARC")) D CKP^GMTSUP Q:$D(GMTSQIT) W "Patient Has Archived OP Prescriptions",! 21 I $L($T(ACS^PSOHCSUM))>0 D ACS^PSOHCSUM I '$D(^TMP("PSOO",$J)) Q 22 I $L($T(ACS^PSOHCSUM))'>0 D ^PSOHCSUM I '$D(^TMP("PSOO",$J)) Q 23 S GMTSLO=GMTSLO+3 24 S (GMTOP,GMX,IX)=0 25 F S IX=$O(^TMP("PSOO",$J,IX)) Q:IX'>0 S GMR=$G(^(IX,0)) D WRT 26 S GMTSLO=GMTSLO-3 27 K ^TMP("PSOO",$J),^UTILITY($J,"W") 28 Q 29 WRT ; Writes OP Pharmacy Segment Record 30 N ID,LFD,X,MI,NL,CF,GMD,GMV,GMI,DIWL,DIWR,DIWF,GMSIG,GUI S GUI=$$HF^GMTSU 31 S ID=$P(GMR,U),LFD=$P(GMR,U,2),ECD=$P(GMR,U,11),CF=$P(GMR,U,10) 32 ; Don't display when issue date is after To Date 33 Q:+$G(GMRANGE)&(ID>(9999999-GMTS1)) 34 F GMV="ID","LFD","ECD" S X=@GMV D REGDT4^GMTSU S @GMV=X K X 35 S NL=0,DIWL=1,DIWR=73,DIWF="" K ^UTILITY($J,"W") 36 F S NL=$O(^TMP("PSOO",$J,IX,NL)) Q:NL'>0 D 37 . S X=$G(^TMP("PSOO",$J,IX,NL,0)) D ^DIWP 38 S GMD=$P($P(GMR,U,4),";",2) 39 D CKP^GMTSUP Q:$D(GMTSQIT) 40 D:GMTSNPG!(GMX'>0) HEAD W:'GMTOP ! S GMTOP=0 W $P($P(GMR,U,3),";",2) 41 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)_")",! 42 S GMX=1,GMI=0,GMSIG=1 43 F S GMI=$O(^UTILITY($J,"W",DIWL,GMI)) Q:GMI'>0!$D(GMTSQIT) D 44 . D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HEAD 45 . S MI=$G(^UTILITY($J,"W",DIWL,GMI,0)) 46 . W:GMSIG=1 ?2,"SIG: " S:GMSIG=1 GMSIG=0 W ?7,MI,! S GMTOP=0 47 D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HEAD W ?4,"Provider: ",$E(GMD,1,22) W:CF ?37,"Cost/Fill: $",$J(CF,6,2) 48 I "EC"[$P($P(GMR,U,5),";"),ECD]"" W ?57,"Exp/Can Dt: "_ECD 49 W ! S GMTOP=0 50 Q 51 HEAD ; Prints Header 52 ; Only write the next line when there is data 53 S GMTOP=1 54 K ^TMP($J,"GMTSPSSYS") D PSS^PSS59P7(1,,"GMTSPSSYS") 55 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",! 56 ;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",! 57 D CKP^GMTSUP Q:$D(GMTSQIT) W !,"Drug....................................",?65,"Last",! 58 D CKP^GMTSUP Q:$D(GMTSQIT) 59 W ?18,"Rx #",?31,"Stat",?45,"Qty",?54,"Issued",?65,"Filled",?76,"Rem" 60 W:$Y'>(IOSL-GMTSLO)!(+($G(GUI))>0) ! 61 Q 1 GMTSPSO7 ; SLC/JER/KER - OP Rx Summary Component (V7) ; 08/27/2002 2 ;;2.7;Health Summary;**15,28,37,56,78**;Oct 20, 1995 3 ; 4 ; External References 5 ; DBIA 330 ^PSOHCSUM, ACS^PSOHCSUM 6 ; DBIA 522 ^PS(55, 7 ; DBIA 10035 ^DPT( file #2 8 ; DBIA 3136 ^PS(59.7, 9 ; DBIA 10011 ^DIWP 10 ; 11 MAIN ; OP Rx HS Component 12 N ECD,GMR,IX,PSOBEGIN,PSOACT,GMX,GMTOP 13 S PSOBEGIN=$S(GMTS2'=9999999:(9999999-GMTS2),1:"") 14 I PSOBEGIN="" S PSOACT=1 K PSOBEGIN 15 K ^TMP("PSOO",$J) 16 I '$D(^PS(55,DFN,"P")),'$D(^("ARC")) Q 17 I '$O(^PS(55,DFN,"P",0)),$D(^PS(55,DFN,"ARC")) D CKP^GMTSUP Q:$D(GMTSQIT) W "Patient Has Archived OP Prescriptions",! 18 I $L($T(ACS^PSOHCSUM))>0 D ACS^PSOHCSUM I '$D(^TMP("PSOO",$J)) Q 19 I $L($T(ACS^PSOHCSUM))'>0 D ^PSOHCSUM I '$D(^TMP("PSOO",$J)) Q 20 S GMTSLO=GMTSLO+3 21 S (GMTOP,GMX,IX)=0 22 F S IX=$O(^TMP("PSOO",$J,IX)) Q:IX'>0 S GMR=$G(^(IX,0)) D WRT 23 S GMTSLO=GMTSLO-3 24 K ^TMP("PSOO",$J),^UTILITY($J,"W") 25 Q 26 WRT ; Writes OP Pharmacy Segment Record 27 N ID,LFD,X,MI,NL,CF,GMD,GMV,GMI,DIWL,DIWR,DIWF,GMSIG,GUI S GUI=$$HF^GMTSU 28 S ID=$P(GMR,U),LFD=$P(GMR,U,2),ECD=$P(GMR,U,11),CF=$P(GMR,U,10) 29 ; Don't display when issue date is after To Date 30 Q:+$G(GMRANGE)&(ID>(9999999-GMTS1)) 31 F GMV="ID","LFD","ECD" S X=@GMV D REGDT4^GMTSU S @GMV=X K X 32 S NL=0,DIWL=1,DIWR=73,DIWF="" K ^UTILITY($J,"W") 33 F S NL=$O(^TMP("PSOO",$J,IX,NL)) Q:NL'>0 D 34 . S X=$G(^TMP("PSOO",$J,IX,NL,0)) D ^DIWP 35 S GMD=$P($P(GMR,U,4),";",2) 36 D CKP^GMTSUP Q:$D(GMTSQIT) 37 D:GMTSNPG!(GMX'>0) HEAD W:'GMTOP ! S GMTOP=0 W $P($P(GMR,U,3),";",2) 38 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)_")",! 39 S GMX=1,GMI=0,GMSIG=1 40 F S GMI=$O(^UTILITY($J,"W",DIWL,GMI)) Q:GMI'>0!$D(GMTSQIT) D 41 . D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HEAD 42 . S MI=$G(^UTILITY($J,"W",DIWL,GMI,0)) 43 . W:GMSIG=1 ?2,"SIG: " S:GMSIG=1 GMSIG=0 W ?7,MI,! S GMTOP=0 44 D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HEAD W ?4,"Provider: ",$E(GMD,1,22) W:CF ?37,"Cost/Fill: $",$J(CF,6,2) 45 I "EC"[$P($P(GMR,U,5),";"),ECD]"" W ?57,"Exp/Can Dt: "_ECD 46 W ! S GMTOP=0 47 Q 48 HEAD ; Prints Header 49 ; Only write the next line when there is data 50 S GMTOP=1 51 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",! 52 D CKP^GMTSUP Q:$D(GMTSQIT) W !,"Drug....................................",?65,"Last",! 53 D CKP^GMTSUP Q:$D(GMTSQIT) 54 W ?18,"Rx #",?31,"Stat",?45,"Qty",?54,"Issued",?65,"Filled",?76,"Rem" 55 W:$Y'>(IOSL-GMTSLO)!(+($G(GUI))>0) ! 56 Q
Note:
See TracChangeset
for help on using the changeset viewer.
