- GMTSPSZO ;SLC/JER - OP Rx 5.6 Summary Component ;12/2/91 13:45 ;
- ;;2.7;Health Summary;**80**;Oct 20, 1995;Build 9
- GMTSPSO ;SLC/JER - OP Rx Summary Component ;12/2/91 13:45 ;
- ;;2.7;Health Summary;;Oct 20, 1995
- MAIN N ECD,GMR,GMW,IX,PSOBEGIN
- S PSOBEGIN=$S(GMTS2'=9999999:(9999999-GMTS2),1:"")
- I PSOBEGIN="" S PSOACT=1
- K ^UTILITY("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",!
- D ^PSOHCSUM I '$D(^UTILITY("PSOO",$J)) Q
- I $D(^DPT(DFN,.1)),^(.1)]"",$D(^DIC(59,+$O(^DIC(59,0)),1)),$P(^(1),"^",8) D CKP^GMTSUP Q:$D(GMTSQIT) W "Outpatient prescriptions are cancelled 72 hours after admission",!
- S GMTSLO=GMTSLO+3
- D HEAD
- S IX=0 F S IX=$O(^UTILITY("PSOO",$J,IX)) Q:IX'>0 S GMR=$G(^(IX,0)) D WRT
- S GMTSLO=GMTSLO-3
- K ^UTILITY("PSOO",$J)
- Q
- HEAD ; Prints Header
- D CKP^GMTSUP Q:$D(GMTSQIT) W ?67,"Last",!
- D CKP^GMTSUP Q:$D(GMTSQIT)
- W "Drug",?27,"Rx #",?38,"St (Exp/Can)",?51,"Qty",?58,"Issued",?67,"Filled",?76,"Rem",! W:$Y'>(IOSL-GMTSLO) !
- Q
- WRT ; Writes OP Pharmacy Segment Record
- N ID,LFD,X,MI,NL,CF,GMD,GMV,GMI
- S ID=$P(GMR,U),LFD=$P(GMR,U,2),ECD=$P(GMR,U,11),CF=$P(GMR,U,10)
- F GMV="ID","LFD","ECD" S X=@GMV D REGDT^GMTSU S @GMV=X K X
- S MI=$G(^UTILITY("PSOO",$J,IX,1)),NL=0 I $L(MI)>73 D PARSE
- S GMD=$P($P(GMR,U,4),";",2)
- D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HEAD W $E($P($P(GMR,U,3),";",2),1,25),?27,$P(GMR,U,6),?38,$P($P(GMR,U,5),";"),?40,$S("EC"[$P($P(GMR,U,5),";"):"("_ECD_")",1:""),?51,$P(GMR,U,7),?57,ID,?67,LFD,?76,"("_$P(GMR,U,8)_")",!
- I 'NL D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HEAD W ?2,MI,!
- F GMI=1:1:NL D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HEAD W ?2,MI(GMI),!
- D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HEAD W ?4,"Provider: ",$E(GMD,1,26) W:CF ?41,"Cost/Fill: $",$J(CF,6,2) W !
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSPSZO 2375 printed Mar 13, 2025@21:04:33 Page 2
- GMTSPSZO ;SLC/JER - OP Rx 5.6 Summary Component ;12/2/91 13:45 ;
- +1 ;;2.7;Health Summary;**80**;Oct 20, 1995;Build 9
- GMTSPSO ;SLC/JER - OP Rx Summary Component ;12/2/91 13:45 ;
- +1 ;;2.7;Health Summary;;Oct 20, 1995
- MAIN NEW ECD,GMR,GMW,IX,PSOBEGIN
- +1 SET PSOBEGIN=$SELECT(GMTS2'=9999999:(9999999-GMTS2),1:"")
- +2 IF PSOBEGIN=""
- SET PSOACT=1
- +3 KILL ^UTILITY("PSOO",$JOB),^TMP($JOB,"GMTSPS")
- +4 DO PROF^PSO52API(DFN,"GMTSPS",1,9999999)
- +5 IF +$GET(^TMP($JOB,"GMTSPS",DFN,0))<1
- IF '$DATA(^TMP($JOB,"GMTSPS",DFN,"ARC"))
- QUIT
- +6 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",!
- +7 ;I '$D(^PS(55,DFN,"P")),'$D(^("ARC")) Q
- +8 ;I '$O(^PS(55,DFN,"P",0)),$D(^PS(55,DFN,"ARC")) D CKP^GMTSUP Q:$D(GMTSQIT) W "Patient Has Archived OP Prescriptions",!
- +9 DO ^PSOHCSUM
- IF '$DATA(^UTILITY("PSOO",$JOB))
- QUIT
- +10 IF $DATA(^DPT(DFN,.1))
- IF ^(.1)]""
- IF $DATA(^DIC(59,+$ORDER(^DIC(59,0)),1))
- IF $PIECE(^(1),"^",8)
- DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- WRITE "Outpatient prescriptions are cancelled 72 hours after admission",!
- +11 SET GMTSLO=GMTSLO+3
- +12 DO HEAD
- +13 SET IX=0
- FOR
- SET IX=$ORDER(^UTILITY("PSOO",$JOB,IX))
- if IX'>0
- QUIT
- SET GMR=$GET(^(IX,0))
- DO WRT
- +14 SET GMTSLO=GMTSLO-3
- +15 KILL ^UTILITY("PSOO",$JOB)
- +16 QUIT
- HEAD ; Prints Header
- +1 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- WRITE ?67,"Last",!
- +2 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- +3 WRITE "Drug",?27,"Rx #",?38,"St (Exp/Can)",?51,"Qty",?58,"Issued",?67,"Filled",?76,"Rem",!
- if $Y'>(IOSL-GMTSLO)
- WRITE !
- +4 QUIT
- WRT ; Writes OP Pharmacy Segment Record
- +1 NEW ID,LFD,X,MI,NL,CF,GMD,GMV,GMI
- +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 FOR GMV="ID","LFD","ECD"
- SET X=@GMV
- DO REGDT^GMTSU
- SET @GMV=X
- KILL X
- +4 SET MI=$GET(^UTILITY("PSOO",$JOB,IX,1))
- SET NL=0
- IF $LENGTH(MI)>73
- DO PARSE
- +5 SET GMD=$PIECE($PIECE(GMR,U,4),";",2)
- +6 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- if GMTSNPG
- DO HEAD
- WRITE $EXTRACT($PIECE($PIECE(GMR,U,3),";",2),1,25),?27,$PIECE(GMR,U,6),?38,$PIECE($PIECE(GMR,U,5),";"),?40,$SELECT("EC"[$PIECE($PIECE(GMR,U,5),";"):"("_ECD_")",1:""),?51,$PIECE(GMR,U,7),?57,ID,?67,LFD,?76,"("_$PIECE(GMR,U,8)_")",!
- +7 IF 'NL
- DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- if GMTSNPG
- DO HEAD
- WRITE ?2,MI,!
- +8 FOR GMI=1:1:NL
- DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- if GMTSNPG
- DO HEAD
- WRITE ?2,MI(GMI),!
- +9 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- if GMTSNPG
- DO HEAD
- WRITE ?4,"Provider: ",$EXTRACT(GMD,1,26)
- if CF
- WRITE ?41,"Cost/Fill: $",$JUSTIFY(CF,6,2)
- WRITE !
- +10 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
