| 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 | 
|---|