- BHSPSO7A ; IHS/MSC/MGH - Health summary selected for medications ;27-Oct-2009 13:39;MGH
- ;;1.0;HEALTH SUMMARY COMONENTS;**3**;March 17,2006
- ;This component allows a user to use selected drugs. The routine will include any
- ;drugs in the VA generic finding for the drugs included
- ; External References
- ; DBIA 60 ^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,NDF,DRUG,GENERIC,GMTSEL,GMR,IX,PSOBEGIN,PSOACT,GMX,GMTOP,MEDSEG
- S PSOBEGIN=$S(GMTS2'=9999999:(9999999-GMTS2),1:"")
- I PSOBEGIN="" S PSOACT=1 K PSOBEGIN
- K ^TMP("BHS",$J)
- Q:$O(GMTSEG(GMTSEGN,50,0))'>0
- S GMTSEL=0
- F S GMTSEL=$O(GMTSEG(GMTSEGN,50,GMTSEL)) Q:'GMTSEL D
- .S DRUG=$G(GMTSEG(GMTSEGN,50,GMTSEL))
- .S MEDSEG(DRUG)=""
- .S NDF=$P($G(^PSDRUG(DRUG,"ND")),U,1)
- .I NDF'="" S GENERIC(NDF)=""
- 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 SEL^BHSPOS(.MEDSEG) I '$D(^TMP("BHS",$J)) Q
- S GMTSLO=GMTSLO+3
- S (GMTOP,GMX,IX)=0
- F S IX=$O(^TMP("BHS",$J,IX)) Q:IX'>0 S GMR=$G(^(IX,0)) D WRT
- S GMTSLO=GMTSLO-3
- K ^TMP("BHS",$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 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("BHS",$J,IX,NL)) Q:NL'>0 D
- . S X=$G(^TMP("BHS",$J,IX,NL,0)) D ^DIWP
- 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 !,?22,$P(GMR,U,6),?35,$P($P(GMR,U,5),";"),?39,$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 ?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
- 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 ?22,"Rx #",?34,"Stat",?39,"Qty",?54,"Issued",?65,"Filled",?76,"Rem"
- W:$Y'>(IOSL-GMTSLO)!(+($G(GUI))>0) !
- Q
- BHSPSO7A ; IHS/MSC/MGH - Health summary selected for medications ;27-Oct-2009 13:39;MGH
- +1 ;;1.0;HEALTH SUMMARY COMONENTS;**3**;March 17,2006
- +2 ;This component allows a user to use selected drugs. The routine will include any
- +3 ;drugs in the VA generic finding for the drugs included
- +4 ; External References
- +5 ; DBIA 60 ^PSOHCSUM
- +6 ; DBIA 522 ^PS(55,
- +7 ; DBIA 10035 ^DPT( file #2
- +8 ; DBIA 3136 ^PS(59.7,
- +9 ; DBIA 10011 ^DIWP
- +10 ;
- MAIN ; OP Rx HS Component
- +1 NEW ECD,NDF,DRUG,GENERIC,GMTSEL,GMR,IX,PSOBEGIN,PSOACT,GMX,GMTOP,MEDSEG
- +2 SET PSOBEGIN=$SELECT(GMTS2'=9999999:(9999999-GMTS2),1:"")
- +3 IF PSOBEGIN=""
- SET PSOACT=1
- KILL PSOBEGIN
- +4 KILL ^TMP("BHS",$JOB)
- +5 IF $ORDER(GMTSEG(GMTSEGN,50,0))'>0
- QUIT
- +6 SET GMTSEL=0
- +7 FOR
- SET GMTSEL=$ORDER(GMTSEG(GMTSEGN,50,GMTSEL))
- IF 'GMTSEL
- QUIT
- Begin DoDot:1
- +8 SET DRUG=$GET(GMTSEG(GMTSEGN,50,GMTSEL))
- +9 SET MEDSEG(DRUG)=""
- +10 SET NDF=$PIECE($GET(^PSDRUG(DRUG,"ND")),U,1)
- +11 IF NDF'=""
- SET GENERIC(NDF)=""
- End DoDot:1
- +12 IF '$DATA(^PS(55,DFN,"P"))
- IF '$DATA(^("ARC"))
- QUIT
- +13 IF '$ORDER(^PS(55,DFN,"P",0))
- IF $DATA(^PS(55,DFN,"ARC"))
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- WRITE "Patient Has Archived OP Prescriptions",!
- +14 DO SEL^BHSPOS(.MEDSEG)
- IF '$DATA(^TMP("BHS",$JOB))
- QUIT
- +15 SET GMTSLO=GMTSLO+3
- +16 SET (GMTOP,GMX,IX)=0
- +17 FOR
- SET IX=$ORDER(^TMP("BHS",$JOB,IX))
- IF IX'>0
- QUIT
- SET GMR=$GET(^(IX,0))
- DO WRT
- +18 SET GMTSLO=GMTSLO-3
- +19 KILL ^TMP("BHS",$JOB),^UTILITY($JOB,"W")
- +20 QUIT
- WRT ; Writes OP Pharmacy Segment Record
- +1 NEW ID,LFD,X,MI,NL,CF,GMD,GMV,GMI,DIWL,DIWR,DIWF,GMSIG,GUI
- 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("BHS",$JOB,IX,NL))
- IF NL'>0
- QUIT
- Begin DoDot:1
- +8 SET X=$GET(^TMP("BHS",$JOB,IX,NL,0))
- DO ^DIWP
- End DoDot:1
- +9 SET GMD=$PIECE($PIECE(GMR,U,4),";",2)
- +10 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +11 IF GMTSNPG!(GMX'>0)
- DO HEAD
- IF 'GMTOP
- WRITE !
- SET GMTOP=0
- WRITE $PIECE($PIECE(GMR,U,3),";",2)
- +12 WRITE !,?22,$PIECE(GMR,U,6),?35,$PIECE($PIECE(GMR,U,5),";"),?39,$PIECE(GMR,U,7),?54,ID,?65,LFD,?76,"("_$PIECE(GMR,U,8)_")",!
- +13 SET GMX=1
- SET GMI=0
- SET GMSIG=1
- +14 FOR
- SET GMI=$ORDER(^UTILITY($JOB,"W",DIWL,GMI))
- IF GMI'>0!$DATA(GMTSQIT)
- QUIT
- Begin DoDot:1
- +15 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF GMTSNPG
- DO HEAD
- +16 SET MI=$GET(^UTILITY($JOB,"W",DIWL,GMI,0))
- +17 IF GMSIG=1
- WRITE ?2,"SIG: "
- IF GMSIG=1
- SET GMSIG=0
- WRITE ?7,MI,!
- SET GMTOP=0
- End DoDot:1
- +18 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF GMTSNPG
- DO HEAD
- WRITE ?4,"Provider: ",$EXTRACT(GMD,1,22)
- IF CF
- WRITE ?37,"Cost/Fill: $",$JUSTIFY(CF,6,2)
- +19 IF "EC"[$PIECE($PIECE(GMR,U,5),";")
- IF ECD]""
- WRITE ?57,"Exp/Can Dt: "_ECD
- +20 WRITE !
- SET GMTOP=0
- +21 QUIT
- HEAD ; Prints Header
- +1 ; Only write the next line when there is data
- +2 SET GMTOP=1
- +3 IF GMX'>0
- IF $DATA(^DPT(DFN,.1))
- IF ^(.1)]""
- IF +($PIECE($GET(^PS(59.7,1,40.1)),"^"))
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- WRITE "Outpatient prescriptions are cancelled 72 hours after admission",!
- +4 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- WRITE !,"Drug....................................",?65,"Last",!
- +5 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +6 WRITE ?22,"Rx #",?34,"Stat",?39,"Qty",?54,"Issued",?65,"Filled",?76,"Rem"
- +7 IF $Y'>(IOSL-GMTSLO)!(+($GET(GUI))>0)
- WRITE !
- +8 QUIT
