Changeset 623 for WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSPSO.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/GMTSPSO.m
r613 r623 1 GMTSPSO ; SLC/JER,KER/NDBI - OP Rx Summary Component (V6) ; 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 10141 $$VERSION^XPDUTL 6 ; DBIA 2931 HS^A7RPSOHS 7 ; DBIA 2931 HS^A7RPSOHS 8 ; DBIA 330 ^PSOHCSUM, ACS^PSOHCSUM 9 ; DBIA 522 ^PS(55, 10 ; DBIA 10035 ^DPT( file #2 11 ; DBIA 3136 ^PS(59.7, 12 ; 13 MAIN ; OP Rx HS Comp 14 ; Check for version 7 (or greater) MAIN^GMTSPSO7 15 I $$VERSION^XPDUTL("PSO")'<7 G MAIN^GMTSPSO7 16 ; If not version 7 MAIN^GMTSPSO 17 N ECD,GMR,IX,PSOBEGIN,PSOACT,GMX,GMTOP 18 S PSOBEGIN=$S(GMTS2'=9999999:(9999999-GMTS2),1:"") 19 I PSOBEGIN="" S PSOACT=1 K PSOBEGIN 20 K ^TMP("PSOO",$J),^TMP($J,"GMTSPS") 21 D PROF^PSO52API(DFN,"GMTSPS",1,9999999) 22 D:$$ROK^GMTSU("A7RPSOHS")&($$NDBI^GMTSU) HS^A7RPSOHS(DFN) 23 I +$G(^TMP($J,"GMTSPS",DFN,0))<1,'$D(^TMP($J,"GMTSPS",DFN,"ARC")) Q 24 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",! 25 ;I '$D(^PS(55,DFN,"P")),'$D(^("ARC")),'$D(^TMP("PSOO",$J)) Q 26 ;I '$O(^PS(55,DFN,"P",0)),$D(^PS(55,DFN,"ARC")) D CKP^GMTSUP Q:$D(GMTSQIT) W "Patient Has Archived OP Prescriptions",! 27 I $L($T(ACS^PSOHCSUM))>0 D ACS^PSOHCSUM D:$$ROK^GMTSU("A7RPSOHS")&($$NDBI^GMTSU) HS^A7RPSOHS(DFN) I '$D(^TMP("PSOO",$J)) Q 28 I $L($T(ACS^PSOHCSUM))'>0 D ^PSOHCSUM D:$$ROK^GMTSU("A7RPSOHS")&($$NDBI^GMTSU) HS^A7RPSOHS(DFN) I '$D(^TMP("PSOO",$J)) Q 29 S GMTSLO=GMTSLO+3 30 S (GMX,GMTOP,IX)=0 31 F S IX=$O(^TMP("PSOO",$J,IX)) Q:IX'>0 S GMR=$G(^(IX,0)) D WRT 32 S GMTSLO=GMTSLO-3 33 K ^TMP("PSOO",$J) 34 Q 35 WRT ; Writes OP Pharmacy Segment Record 36 N ID,LFD,X,MI,NL,CF,GMD,GMV,GMI,GUI S GUI=$$HF^GMTSU 37 S ID=$P(GMR,U),LFD=$P(GMR,U,2),ECD=$P(GMR,U,11),CF=$P(GMR,U,10) 38 ; Don't display when issue date is after To Date 39 Q:+$G(GMRANGE)&(ID>(9999999-GMTS1)) 40 F GMV="ID","LFD","ECD" S X=@GMV D REGDT4^GMTSU S @GMV=X K X 41 S MI=$G(^TMP("PSOO",$J,IX,1)),NL=0 I $L(MI)>73 D PARSE 42 S GMD=$P($P(GMR,U,4),";",2) 43 D CKP^GMTSUP Q:$D(GMTSQIT) 44 D:GMTSNPG!(GMX'>0) HEAD W:'GMTOP ! S GMTOP=0 W $P($P(GMR,U,3),";",2) 45 W !,?18,$P(GMR,U,6),?31,$S($P($P(GMR,U,5),";")="S":"ACTIVE/SUSP",1:$P($P(GMR,U,5),";",2)),?45,$P(GMR,U,7),?54,ID,?65,LFD,?76,"("_$P(GMR,U,8)_")",! 46 S GMX=1 I 'NL D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HEAD W ?2,"SIG: ",MI,! S GMTOP=0 47 F GMI=1:1:NL D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HEAD W:GMI=1 ?2,"SIG: " W ?7,MI(GMI),! S GMTOP=0 48 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) 49 I "EC"[$P($P(GMR,U,5),";"),ECD]"" W ?57,"Exp/Can Dt: "_ECD 50 W ! S GMTOP=0 51 Q 52 PARSE ; Parses Medication Instructions 53 N GMI,NW,WPL 54 S NL=$S(($L(MI)/73)>($L(MI)\73):($L(MI)\73)+1,1:$L(MI)\73) 55 S NW=$L(MI," "),WPL=$S((NW/NL)>(NW\NL):(NW\NL)+1,1:NW\NL) 56 F GMI=1:1:NL S MI(GMI)=$P(MI," ",(GMI-1)*WPL+1,GMI*WPL) 57 Q 58 HEAD ; Prints Header 59 S GMTOP=1 60 K ^TMP($J,"GMTSPSSYS") D PSS^PSS59P7(1,,"GMTSPSSYS") 61 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",! 62 ;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",! 63 D CKP^GMTSUP Q:$D(GMTSQIT) W !,"Drug....................................",?65,"Last",! 64 D CKP^GMTSUP Q:$D(GMTSQIT) 65 W ?18,"Rx #",?31,"Stat",?45,"Qty",?54,"Issued",?65,"Filled",?76,"Rem" 66 W:$Y'>(IOSL-GMTSLO)!(+($G(GUI))>0) ! 67 Q 1 GMTSPSO ; SLC/JER,KER/NDBI - OP Rx Summary Component (V6) ; 08/27/2002 2 ;;2.7;Health Summary;**15,28,37,56,78**;Oct 20, 1995 3 ; 4 ; External References 5 ; DBIA 10141 $$VERSION^XPDUTL 6 ; DBIA 2931 HS^A7RPSOHS 7 ; DBIA 2931 HS^A7RPSOHS 8 ; DBIA 330 ^PSOHCSUM, ACS^PSOHCSUM 9 ; DBIA 522 ^PS(55, 10 ; DBIA 10035 ^DPT( file #2 11 ; DBIA 3136 ^PS(59.7, 12 ; 13 MAIN ; OP Rx HS Comp 14 ; Check for version 7 (or greater) MAIN^GMTSPSO7 15 I $$VERSION^XPDUTL("PSO")'<7 G MAIN^GMTSPSO7 16 ; If not version 7 MAIN^GMTSPSO 17 N ECD,GMR,IX,PSOBEGIN,PSOACT,GMX,GMTOP 18 S PSOBEGIN=$S(GMTS2'=9999999:(9999999-GMTS2),1:"") 19 I PSOBEGIN="" S PSOACT=1 K PSOBEGIN 20 K ^TMP("PSOO",$J) 21 D:$$ROK^GMTSU("A7RPSOHS")&($$NDBI^GMTSU) HS^A7RPSOHS(DFN) 22 I '$D(^PS(55,DFN,"P")),'$D(^("ARC")),'$D(^TMP("PSOO",$J)) Q 23 I '$O(^PS(55,DFN,"P",0)),$D(^PS(55,DFN,"ARC")) D CKP^GMTSUP Q:$D(GMTSQIT) W "Patient Has Archived OP Prescriptions",! 24 I $L($T(ACS^PSOHCSUM))>0 D ACS^PSOHCSUM D:$$ROK^GMTSU("A7RPSOHS")&($$NDBI^GMTSU) HS^A7RPSOHS(DFN) I '$D(^TMP("PSOO",$J)) Q 25 I $L($T(ACS^PSOHCSUM))'>0 D ^PSOHCSUM D:$$ROK^GMTSU("A7RPSOHS")&($$NDBI^GMTSU) HS^A7RPSOHS(DFN) I '$D(^TMP("PSOO",$J)) Q 26 S GMTSLO=GMTSLO+3 27 S (GMX,GMTOP,IX)=0 28 F S IX=$O(^TMP("PSOO",$J,IX)) Q:IX'>0 S GMR=$G(^(IX,0)) D WRT 29 S GMTSLO=GMTSLO-3 30 K ^TMP("PSOO",$J) 31 Q 32 WRT ; Writes OP Pharmacy Segment Record 33 N ID,LFD,X,MI,NL,CF,GMD,GMV,GMI,GUI S GUI=$$HF^GMTSU 34 S ID=$P(GMR,U),LFD=$P(GMR,U,2),ECD=$P(GMR,U,11),CF=$P(GMR,U,10) 35 ; Don't display when issue date is after To Date 36 Q:+$G(GMRANGE)&(ID>(9999999-GMTS1)) 37 F GMV="ID","LFD","ECD" S X=@GMV D REGDT4^GMTSU S @GMV=X K X 38 S MI=$G(^TMP("PSOO",$J,IX,1)),NL=0 I $L(MI)>73 D PARSE 39 S GMD=$P($P(GMR,U,4),";",2) 40 D CKP^GMTSUP Q:$D(GMTSQIT) 41 D:GMTSNPG!(GMX'>0) HEAD W:'GMTOP ! S GMTOP=0 W $P($P(GMR,U,3),";",2) 42 W !,?18,$P(GMR,U,6),?31,$S($P($P(GMR,U,5),";")="S":"ACTIVE/SUSP",1:$P($P(GMR,U,5),";",2)),?45,$P(GMR,U,7),?54,ID,?65,LFD,?76,"("_$P(GMR,U,8)_")",! 43 S GMX=1 I 'NL D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HEAD W ?2,"SIG: ",MI,! S GMTOP=0 44 F GMI=1:1:NL D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HEAD W:GMI=1 ?2,"SIG: " W ?7,MI(GMI),! S GMTOP=0 45 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) 46 I "EC"[$P($P(GMR,U,5),";"),ECD]"" W ?57,"Exp/Can Dt: "_ECD 47 W ! S GMTOP=0 48 Q 49 PARSE ; Parses Medication Instructions 50 N GMI,NW,WPL 51 S NL=$S(($L(MI)/73)>($L(MI)\73):($L(MI)\73)+1,1:$L(MI)\73) 52 S NW=$L(MI," "),WPL=$S((NW/NL)>(NW\NL):(NW\NL)+1,1:NW\NL) 53 F GMI=1:1:NL S MI(GMI)=$P(MI," ",(GMI-1)*WPL+1,GMI*WPL) 54 Q 55 HEAD ; Prints Header 56 S GMTOP=1 57 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",! 58 D CKP^GMTSUP Q:$D(GMTSQIT) W !,"Drug....................................",?65,"Last",! 59 D CKP^GMTSUP Q:$D(GMTSQIT) 60 W ?18,"Rx #",?31,"Stat",?45,"Qty",?54,"Issued",?65,"Filled",?76,"Rem" 61 W:$Y'>(IOSL-GMTSLO)!(+($G(GUI))>0) ! 62 Q
Note:
See TracChangeset
for help on using the changeset viewer.
