- GMTSPSO7 ;SLC/JER/KER - OP Rx Summary Component (V7) ;Apr 16, 2021@16:08
- ;;2.7;Health Summary;**15,28,37,56,78,80,115**;Oct 20, 1995;Build 190
- ;
- ; External References
- ; DBIA 330 ^PSOHCSUM, ACS^PSOHCSUM
- ; DBIA 522 ^PS(55,
- ; DBIA 10035 ^DPT( file #2
- ; DBIA 3136 ^PS(59.7,
- ; DBIA 10011 ^DIWP
- ;
- MAIN ; OP Rx HS Component
- 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)
- 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")) 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 I '$D(^TMP("PSOO",$J)) Q
- I $L($T(ACS^PSOHCSUM))'>0 D ^PSOHCSUM I '$D(^TMP("PSOO",$J)) Q
- S GMTSLO=GMTSLO+3
- S (GMTOP,GMX,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),^UTILITY($J,"W")
- Q
- WRT ; Writes OP Pharmacy Segment Record
- N ID,LFD,X,MI,NL,CF,GMD,GMV,GMI,DIWL,DIWR,DIWF,GMSIG,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 NL=0,DIWL=1,DIWR=73,DIWF="" K ^UTILITY($J,"W")
- F S NL=$O(^TMP("PSOO",$J,IX,NL)) Q:NL'>0 D
- . S X=$G(^TMP("PSOO",$J,IX,NL,0)) D ^DIWP
- S GMD=$P($P(GMR,U,4),";",2)
- S IND=$P($G(^TMP("PSOO",$J,IX,"IND")),U)
- 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($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)_")",!
- S GMX=1,GMI=0,GMSIG=1
- F S GMI=$O(^UTILITY($J,"W",DIWL,GMI)) Q:GMI'>0!$D(GMTSQIT) D
- . D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HEAD
- . S MI=$G(^UTILITY($J,"W",DIWL,GMI,0))
- . W:GMSIG=1 ?2,"SIG: " S:GMSIG=1 GMSIG=0 W ?7,MI,! 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
- HEAD ; Prints Header
- ; Only write the next line when there is data
- 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[HGMTSPSO7 3224 printed Feb 18, 2025@23:25:58 Page 2
- 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
- +2 ;
- +3 ; External References
- +4 ; DBIA 330 ^PSOHCSUM, ACS^PSOHCSUM
- +5 ; DBIA 522 ^PS(55,
- +6 ; DBIA 10035 ^DPT( file #2
- +7 ; DBIA 3136 ^PS(59.7,
- +8 ; DBIA 10011 ^DIWP
- +9 ;
- MAIN ; OP Rx HS Component
- +1 NEW ECD,GMR,IX,PSOBEGIN,PSOACT,GMX,GMTOP
- +2 SET PSOBEGIN=$SELECT(GMTS2'=9999999:(9999999-GMTS2),1:"")
- +3 IF PSOBEGIN=""
- SET PSOACT=1
- KILL PSOBEGIN
- +4 KILL ^TMP("PSOO",$JOB),^TMP($JOB,"GMTSPS")
- +5 DO PROF^PSO52API(DFN,"GMTSPS",1,9999999)
- +6 IF +$GET(^TMP($JOB,"GMTSPS",DFN,0))<1
- IF '$DATA(^TMP($JOB,"GMTSPS",DFN,"ARC"))
- QUIT
- +7 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",!
- +8 ;I '$D(^PS(55,DFN,"P")),'$D(^("ARC")) Q
- +9 ;I '$O(^PS(55,DFN,"P",0)),$D(^PS(55,DFN,"ARC")) D CKP^GMTSUP Q:$D(GMTSQIT) W "Patient Has Archived OP Prescriptions",!
- +10 IF $LENGTH($TEXT(ACS^PSOHCSUM))>0
- DO ACS^PSOHCSUM
- IF '$DATA(^TMP("PSOO",$JOB))
- QUIT
- +11 IF $LENGTH($TEXT(ACS^PSOHCSUM))'>0
- DO ^PSOHCSUM
- IF '$DATA(^TMP("PSOO",$JOB))
- QUIT
- +12 SET GMTSLO=GMTSLO+3
- +13 SET (GMTOP,GMX,IX)=0
- +14 FOR
- SET IX=$ORDER(^TMP("PSOO",$JOB,IX))
- if IX'>0
- QUIT
- SET GMR=$GET(^(IX,0))
- DO WRT
- +15 SET GMTSLO=GMTSLO-3
- +16 KILL ^TMP("PSOO",$JOB),^UTILITY($JOB,"W")
- +17 QUIT
- WRT ; Writes OP Pharmacy Segment Record
- +1 NEW ID,LFD,X,MI,NL,CF,GMD,GMV,GMI,DIWL,DIWR,DIWF,GMSIG,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 NL=0
- SET DIWL=1
- SET DIWR=73
- SET DIWF=""
- KILL ^UTILITY($JOB,"W")
- +7 FOR
- SET NL=$ORDER(^TMP("PSOO",$JOB,IX,NL))
- if NL'>0
- QUIT
- Begin DoDot:1
- +8 SET X=$GET(^TMP("PSOO",$JOB,IX,NL,0))
- DO ^DIWP
- End DoDot:1
- +9 SET GMD=$PIECE($PIECE(GMR,U,4),";",2)
- +10 SET IND=$PIECE($GET(^TMP("PSOO",$JOB,IX,"IND")),U)
- +11 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- +12 if GMTSNPG!(GMX'>0)
- DO HEAD
- if 'GMTOP
- WRITE !
- SET GMTOP=0
- WRITE $PIECE($PIECE(GMR,U,3),";",2)
- +13 WRITE !,?18,$PIECE(GMR,U,6),?31,$SELECT($GET(GMR)["SUSPENDED":"ACTIVE/SUSP",1:$PIECE($PIECE(GMR,U,5),";",2)),?45,$PIECE(GMR,U,7),?54,ID,?65,LFD,?76,"("_$PIECE(GMR,U,8)_")",!
- +14 SET GMX=1
- SET GMI=0
- SET GMSIG=1
- +15 FOR
- SET GMI=$ORDER(^UTILITY($JOB,"W",DIWL,GMI))
- if GMI'>0!$DATA(GMTSQIT)
- QUIT
- Begin DoDot:1
- +16 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- if GMTSNPG
- DO HEAD
- +17 SET MI=$GET(^UTILITY($JOB,"W",DIWL,GMI,0))
- +18 if GMSIG=1
- WRITE ?2,"SIG: "
- if GMSIG=1
- SET GMSIG=0
- WRITE ?7,MI,!
- SET GMTOP=0
- End DoDot:1
- +19 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- if GMTSNPG
- DO HEAD
- +20 if IND]""
- WRITE ?4,"Indication: "_IND,!
- WRITE ?4,"Provider: ",$EXTRACT(GMD,1,22)
- +21 if CF
- WRITE ?37,"Cost/Fill: $",$JUSTIFY(CF,6,2)
- +22 IF "EC"[$PIECE($PIECE(GMR,U,5),";")
- IF ECD]""
- WRITE ?57,"Exp/Can Dt: "_ECD
- +23 WRITE !
- SET GMTOP=0
- +24 QUIT
- HEAD ; Prints Header
- +1 ; Only write the next line when there is data
- +2 SET GMTOP=1
- +3 KILL ^TMP($JOB,"GMTSPSSYS")
- DO PSS^PSS59P7(1,,"GMTSPSSYS")
- +4 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",!
- +5 ;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",!
- +6 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- WRITE !,"Drug....................................",?65,"Last",!
- +7 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- +8 WRITE ?18,"Rx #",?31,"Stat",?45,"Qty",?54,"Issued",?65,"Filled",?76,"Rem"
- +9 if $Y'>(IOSL-GMTSLO)!(+($GET(GUI))>0)
- WRITE !
- +10 QUIT