GMTSPSO ;SLC/JER,KER/NDBI - OP Rx Summary Component (V6) ;Apr 16, 2021@16:16:52
;;2.7;Health Summary;**15,28,37,56,78,80,115**;Oct 20, 1995;Build 190
;
; External References
; DBIA 10141 $$VERSION^XPDUTL
; DBIA 2931 HS^A7RPSOHS
; DBIA 2931 HS^A7RPSOHS
; DBIA 330 ^PSOHCSUM, ACS^PSOHCSUM
; DBIA 522 ^PS(55,
; DBIA 10035 ^DPT( file #2
; DBIA 3136 ^PS(59.7,
; DBIA 4820 ^PSO52API
;
MAIN ; OP Rx HS Comp
; Check for version 7 (or greater) MAIN^GMTSPSO7
I $$VERSION^XPDUTL("PSO")'<7 G MAIN^GMTSPSO7
; If not version 7 MAIN^GMTSPSO
N ECD,GMR,IX,PSOBEGIN,PSOACT,GMX,GMTOP
S PSOBEGIN=$S(GMTS2'=9999999:(9999999-GMTS2),1:"")
I PSOBEGIN="" S PSOACT=1 K PSOBEGIN
K ^TMP("PSOO",$J),^TMP($J,"GMTSPS")
D PROF^PSO52API(DFN,"GMTSPS",1,9999999)
D:$$ROK^GMTSU("A7RPSOHS")&($$NDBI^GMTSU) HS^A7RPSOHS(DFN)
I +$G(^TMP($J,"GMTSPS",DFN,0))<1,'$D(^TMP($J,"GMTSPS",DFN,"ARC")) Q
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",!
;I '$D(^PS(55,DFN,"P")),'$D(^("ARC")),'$D(^TMP("PSOO",$J)) Q
;I '$O(^PS(55,DFN,"P",0)),$D(^PS(55,DFN,"ARC")) D CKP^GMTSUP Q:$D(GMTSQIT) W "Patient Has Archived OP Prescriptions",!
I $L($T(ACS^PSOHCSUM))>0 D ACS^PSOHCSUM D:$$ROK^GMTSU("A7RPSOHS")&($$NDBI^GMTSU) HS^A7RPSOHS(DFN) I '$D(^TMP("PSOO",$J)) Q
I $L($T(ACS^PSOHCSUM))'>0 D ^PSOHCSUM D:$$ROK^GMTSU("A7RPSOHS")&($$NDBI^GMTSU) HS^A7RPSOHS(DFN) I '$D(^TMP("PSOO",$J)) Q
S GMTSLO=GMTSLO+3
S (GMX,GMTOP,IX)=0
F S IX=$O(^TMP("PSOO",$J,IX)) Q:IX'>0 S GMR=$G(^(IX,0)) D WRT
S GMTSLO=GMTSLO-3
K ^TMP("PSOO",$J)
Q
WRT ; Writes OP Pharmacy Segment Record
N ID,LFD,X,MI,NL,CF,GMD,GMV,GMI,GUI,IND S GUI=$$HF^GMTSU
S ID=$P(GMR,U),LFD=$P(GMR,U,2),ECD=$P(GMR,U,11),CF=$P(GMR,U,10)
; Don't display when issue date is after To Date
Q:+$G(GMRANGE)&(ID>(9999999-GMTS1))
F GMV="ID","LFD","ECD" S X=@GMV D REGDT4^GMTSU S @GMV=X K X
S MI=$G(^TMP("PSOO",$J,IX,1)),NL=0 I $L(MI)>73 D PARSE
S IND=$P($G(^TMP("PSOO",$J,IX,"IND")),U)
S GMD=$P($P(GMR,U,4),";",2)
D CKP^GMTSUP Q:$D(GMTSQIT)
D:GMTSNPG!(GMX'>0) HEAD W:'GMTOP ! S GMTOP=0 W $P($P(GMR,U,3),";",2)
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)_")",!
S GMX=1 I 'NL D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HEAD W ?2,"SIG: ",MI,! S GMTOP=0
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
D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HEAD W:IND]"" ?4,"Indication: "_IND,! W ?4,"Provider: ",$E(GMD,1,22) W:CF ?37,"Cost/Fill: $",$J(CF,6,2)
I "EC"[$P($P(GMR,U,5),";"),ECD]"" W ?57,"Exp/Can Dt: "_ECD
W ! S GMTOP=0
Q
PARSE ; Parses Medication Instructions
N GMI,NW,WPL
S NL=$S(($L(MI)/73)>($L(MI)\73):($L(MI)\73)+1,1:$L(MI)\73)
S NW=$L(MI," "),WPL=$S((NW/NL)>(NW\NL):(NW\NL)+1,1:NW\NL)
F GMI=1:1:NL S MI(GMI)=$P(MI," ",(GMI-1)*WPL+1,GMI*WPL)
Q
HEAD ; Prints Header
S GMTOP=1
K ^TMP($J,"GMTSPSSYS") D PSS^PSS59P7(1,,"GMTSPSSYS")
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",!
;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",!
D CKP^GMTSUP Q:$D(GMTSQIT) W !,"Drug....................................",?65,"Last",!
D CKP^GMTSUP Q:$D(GMTSQIT)
W ?18,"Rx #",?31,"Stat",?45,"Qty",?54,"Issued",?65,"Filled",?76,"Rem"
W:$Y'>(IOSL-GMTSLO)!(+($G(GUI))>0) !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSPSO 3695 printed Sep 23, 2025@19:35:40 Page 2
GMTSPSO ;SLC/JER,KER/NDBI - OP Rx Summary Component (V6) ;Apr 16, 2021@16:16:52
+1 ;;2.7;Health Summary;**15,28,37,56,78,80,115**;Oct 20, 1995;Build 190
+2 ;
+3 ; External References
+4 ; DBIA 10141 $$VERSION^XPDUTL
+5 ; DBIA 2931 HS^A7RPSOHS
+6 ; DBIA 2931 HS^A7RPSOHS
+7 ; DBIA 330 ^PSOHCSUM, ACS^PSOHCSUM
+8 ; DBIA 522 ^PS(55,
+9 ; DBIA 10035 ^DPT( file #2
+10 ; DBIA 3136 ^PS(59.7,
+11 ; DBIA 4820 ^PSO52API
+12 ;
MAIN ; OP Rx HS Comp
+1 ; Check for version 7 (or greater) MAIN^GMTSPSO7
+2 IF $$VERSION^XPDUTL("PSO")'<7
GOTO MAIN^GMTSPSO7
+3 ; If not version 7 MAIN^GMTSPSO
+4 NEW ECD,GMR,IX,PSOBEGIN,PSOACT,GMX,GMTOP
+5 SET PSOBEGIN=$SELECT(GMTS2'=9999999:(9999999-GMTS2),1:"")
+6 IF PSOBEGIN=""
SET PSOACT=1
KILL PSOBEGIN
+7 KILL ^TMP("PSOO",$JOB),^TMP($JOB,"GMTSPS")
+8 DO PROF^PSO52API(DFN,"GMTSPS",1,9999999)
+9 if $$ROK^GMTSU("A7RPSOHS")&($$NDBI^GMTSU)
DO HS^A7RPSOHS(DFN)
+10 IF +$GET(^TMP($JOB,"GMTSPS",DFN,0))<1
IF '$DATA(^TMP($JOB,"GMTSPS",DFN,"ARC"))
QUIT
+11 IF '$GET(^TMP($JOB,"GMTSPS",DFN,0))
IF $DATA(^TMP($JOB,"GMTSPS",DFN,"ARC"))
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE "Patient Has Archived OP Prescriptions",!
+12 ;I '$D(^PS(55,DFN,"P")),'$D(^("ARC")),'$D(^TMP("PSOO",$J)) Q
+13 ;I '$O(^PS(55,DFN,"P",0)),$D(^PS(55,DFN,"ARC")) D CKP^GMTSUP Q:$D(GMTSQIT) W "Patient Has Archived OP Prescriptions",!
+14 IF $LENGTH($TEXT(ACS^PSOHCSUM))>0
DO ACS^PSOHCSUM
if $$ROK^GMTSU("A7RPSOHS")&($$NDBI^GMTSU)
DO HS^A7RPSOHS(DFN)
IF '$DATA(^TMP("PSOO",$JOB))
QUIT
+15 IF $LENGTH($TEXT(ACS^PSOHCSUM))'>0
DO ^PSOHCSUM
if $$ROK^GMTSU("A7RPSOHS")&($$NDBI^GMTSU)
DO HS^A7RPSOHS(DFN)
IF '$DATA(^TMP("PSOO",$JOB))
QUIT
+16 SET GMTSLO=GMTSLO+3
+17 SET (GMX,GMTOP,IX)=0
+18 FOR
SET IX=$ORDER(^TMP("PSOO",$JOB,IX))
if IX'>0
QUIT
SET GMR=$GET(^(IX,0))
DO WRT
+19 SET GMTSLO=GMTSLO-3
+20 KILL ^TMP("PSOO",$JOB)
+21 QUIT
WRT ; Writes OP Pharmacy Segment Record
+1 NEW ID,LFD,X,MI,NL,CF,GMD,GMV,GMI,GUI,IND
SET GUI=$$HF^GMTSU
+2 SET ID=$PIECE(GMR,U)
SET LFD=$PIECE(GMR,U,2)
SET ECD=$PIECE(GMR,U,11)
SET CF=$PIECE(GMR,U,10)
+3 ; Don't display when issue date is after To Date
+4 if +$GET(GMRANGE)&(ID>(9999999-GMTS1))
QUIT
+5 FOR GMV="ID","LFD","ECD"
SET X=@GMV
DO REGDT4^GMTSU
SET @GMV=X
KILL X
+6 SET MI=$GET(^TMP("PSOO",$JOB,IX,1))
SET NL=0
IF $LENGTH(MI)>73
DO PARSE
+7 SET IND=$PIECE($GET(^TMP("PSOO",$JOB,IX,"IND")),U)
+8 SET GMD=$PIECE($PIECE(GMR,U,4),";",2)
+9 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+10 if GMTSNPG!(GMX'>0)
DO HEAD
if 'GMTOP
WRITE !
SET GMTOP=0
WRITE $PIECE($PIECE(GMR,U,3),";",2)
+11 WRITE !,?18,$PIECE(GMR,U,6),?31,$SELECT($PIECE($PIECE(GMR,U,5),";")="S":"ACTIVE/SUSP",1:$PIECE($PIECE(GMR,U,5),";",2)),?45,$PIECE(GMR,U,7),?54,ID,?65,LFD,?76,"("_$PIECE(GMR,U,8)_")",!
+12 SET GMX=1
IF 'NL
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO HEAD
WRITE ?2,"SIG: ",MI,!
SET GMTOP=0
+13 FOR GMI=1:1:NL
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO HEAD
if GMI=1
WRITE ?2,"SIG: "
WRITE ?7,MI(GMI),!
SET GMTOP=0
+14 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO HEAD
if IND]""
WRITE ?4,"Indication: "_IND,!
WRITE ?4,"Provider: ",$EXTRACT(GMD,1,22)
if CF
WRITE ?37,"Cost/Fill: $",$JUSTIFY(CF,6,2)
+15 IF "EC"[$PIECE($PIECE(GMR,U,5),";")
IF ECD]""
WRITE ?57,"Exp/Can Dt: "_ECD
+16 WRITE !
SET GMTOP=0
+17 QUIT
PARSE ; Parses Medication Instructions
+1 NEW GMI,NW,WPL
+2 SET NL=$SELECT(($LENGTH(MI)/73)>($LENGTH(MI)\73):($LENGTH(MI)\73)+1,1:$LENGTH(MI)\73)
+3 SET NW=$LENGTH(MI," ")
SET WPL=$SELECT((NW/NL)>(NW\NL):(NW\NL)+1,1:NW\NL)
+4 FOR GMI=1:1:NL
SET MI(GMI)=$PIECE(MI," ",(GMI-1)*WPL+1,GMI*WPL)
+5 QUIT
HEAD ; Prints Header
+1 SET GMTOP=1
+2 KILL ^TMP($JOB,"GMTSPSSYS")
DO PSS^PSS59P7(1,,"GMTSPSSYS")
+3 IF GMX'>0
IF $DATA(^DPT(DFN,.1))
IF ^(.1)]""
IF +$GET(^TMP($JOB,"GMTSPSSYS",1,40.1))
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE "Outpatient prescriptions are cancelled 72 hours after admission",!
+4 ;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",!
+5 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE !,"Drug....................................",?65,"Last",!
+6 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+7 WRITE ?18,"Rx #",?31,"Stat",?45,"Qty",?54,"Issued",?65,"Filled",?76,"Rem"
+8 if $Y'>(IOSL-GMTSLO)!(+($GET(GUI))>0)
WRITE !
+9 QUIT
