- BHSPMH1A ;IHS/MSC/MGH - Health Summary for Patient wellness handout ;27-May-2008 14:21;MGH
- ;;1.0;HEALTH SUMMARY COMPONENTS;**1,2**;March 17,2006
- ;===================================================================
- ;Taken from APCHPMH1 routine
- ;
- ;
- MEDBLD ; EP - BUILD ARRAY OF MEDICATIONS
- ;
- K APCHSRXP,APCHSCOT
- N APCHSN,APCHSDTM,APCHSSTA,APCHSDYS,RX0,RX2,ST,ST0
- Q:'$D(^AUPNVMED(APCHSMX,0))
- S APCHSN=^AUPNVMED(APCHSMX,0)
- Q:'$D(^PSDRUG($P(APCHSN,U,1)))
- S APCHSDTM=-APCHSIVD\1+9999999 ;Visit date from V Med .03 field
- Q:$P(APCHSN,U,8)]"" ;date discontinued
- S APCHSRXP=$S($D(^PSRX("APCC",APCHSMX)):$O(^(APCHSMX,0)),1:0) ;RX IEN
- I APCHSRXP>0 S RX0=^PSRX(APCHSRXP,0),RX2=^PSRX(APCHSRXP,2) I '$D(^PSRX(APCHSRXP,"STA")) D RXSTAT^BHSPMH1 Q:ST="EXPIRED"!(ST="CANCELLED")!(ST="DELETED") ;CALCULATE RX STATUS
- I $G(APCHSRXP)'>0 S APCHSCOT=1 ;may be using COTS or med entered via PCC data entry
- I $P($G(^AUPNVMED(APCHSMX,12)),U,9)]"" S APCHSCOT=1 ;external key present
- S APCHSSTA=$P($G(^PSRX(APCHSRXP,0)),U,15) ;Active? RX File status
- Q:$G(APCHSSTA)>10 ;status is expired, deleted or cancelled
- I $G(^PSRX(APCHSRXP,"STA"))>10 Q ;Status is in "STA" node in V 7
- I $G(^PSRX(APCHSRXP,"STA"))=1 Q ;NON-VERIFIED
- I $G(^PSRX(APCHSRXP,"STA"))=4 Q ;DRUG INTERACTION
- S APCHSIG=""
- S APCHSIG=$P($G(APCHSN),U,5)
- D SIG ;D ^BOMB ;get expanded sig
- S APCHSDYS=$P($G(APCHSN),U,7) ;days supply
- ;Q:APCHSDYS=1 ;quit if only 1 day supply
- I $G(APCHSCOT)=1,$G(APCHSDYS)]"",$$FMDIFF^XLFDT(DT,APCHSDTM)>$G(APCHSDYS) Q
- Q:$P($G(^AUPNVMED(APCHSMX,0)),U,6)=1 ;quit if qty=1
- S APCHSMFX=$P(^PSDRUG(+APCHSN,0),U) D ;compare Drug File .01 field & V Med Name of Non Table Drug
- .Q:$P(APCHSN,U,4)=""
- .I $P($G(APCHSN),U,4)]"",$P($G(APCHSN),U,4)=$P(^PSDRUG(+APCHSN,0),U) Q
- .I $P($G(APCHSN),U,4)]"",$P($G(APCHSN),U,4)'=$P(^PSDRUG(+APCHSN,0),U) S APCHSMFX=$P(APCHSN,U,4)
- .Q
- I $G(APCHSM(APCHSMFX)) Q ;quit if med already exists
- S APCHSM(APCHSMFX)=+APCHSN_U_APCHSDYS ;PSDRUG ien^days supply
- I $G(APCHSRXP)>0 S $P(APCHSM(APCHSMFX),U,3)=APCHSRXP ;^PSRX ien
- S $P(APCHSM(APCHSMFX),U,4)=$G(ST) ;status from RXSTAT
- S $P(APCHSM(APCHSMFX),U,5)=$G(APCHSSGY)
- S APCHSMCT=APCHSMCT+1 ;number of active meds
- Q
- ;
- SIG ;CONSTRUCT THE FULL TEXT FROM THE ENCODED SIG
- S APCHSSGY="" F APCHSP=1:1:$L(APCHSIG," ") S X=$P(APCHSIG," ",APCHSP) I X]"" D
- . S Y=$O(^PS(51,"B",X,0)) I Y>0 S X=$P(^PS(51,Y,0),"^",2) I $D(^(9)) S Y=$P(APCHSIG," ",APCHSP-1),Y=$E(Y,$L(Y)) S:Y>1 X=$P(^(9),"^",1)
- . S APCHSSGY=APCHSSGY_X_" "
- Q
- BHSPMH1A ;IHS/MSC/MGH - Health Summary for Patient wellness handout ;27-May-2008 14:21;MGH
- +1 ;;1.0;HEALTH SUMMARY COMPONENTS;**1,2**;March 17,2006
- +2 ;===================================================================
- +3 ;Taken from APCHPMH1 routine
- +4 ;
- +5 ;
- MEDBLD ; EP - BUILD ARRAY OF MEDICATIONS
- +1 ;
- +2 KILL APCHSRXP,APCHSCOT
- +3 NEW APCHSN,APCHSDTM,APCHSSTA,APCHSDYS,RX0,RX2,ST,ST0
- +4 IF '$DATA(^AUPNVMED(APCHSMX,0))
- QUIT
- +5 SET APCHSN=^AUPNVMED(APCHSMX,0)
- +6 IF '$DATA(^PSDRUG($PIECE(APCHSN,U,1)))
- QUIT
- +7 ;Visit date from V Med .03 field
- SET APCHSDTM=-APCHSIVD\1+9999999
- +8 ;date discontinued
- IF $PIECE(APCHSN,U,8)]""
- QUIT
- +9 ;RX IEN
- SET APCHSRXP=$SELECT($DATA(^PSRX("APCC",APCHSMX)):$ORDER(^(APCHSMX,0)),1:0)
- +10 ;CALCULATE RX STATUS
- IF APCHSRXP>0
- SET RX0=^PSRX(APCHSRXP,0)
- SET RX2=^PSRX(APCHSRXP,2)
- IF '$DATA(^PSRX(APCHSRXP,"STA"))
- DO RXSTAT^BHSPMH1
- IF ST="EXPIRED"!(ST="CANCELLED")!(ST="DELETED")
- QUIT
- +11 ;may be using COTS or med entered via PCC data entry
- IF $GET(APCHSRXP)'>0
- SET APCHSCOT=1
- +12 ;external key present
- IF $PIECE($GET(^AUPNVMED(APCHSMX,12)),U,9)]""
- SET APCHSCOT=1
- +13 ;Active? RX File status
- SET APCHSSTA=$PIECE($GET(^PSRX(APCHSRXP,0)),U,15)
- +14 ;status is expired, deleted or cancelled
- IF $GET(APCHSSTA)>10
- QUIT
- +15 ;Status is in "STA" node in V 7
- IF $GET(^PSRX(APCHSRXP,"STA"))>10
- QUIT
- +16 ;NON-VERIFIED
- IF $GET(^PSRX(APCHSRXP,"STA"))=1
- QUIT
- +17 ;DRUG INTERACTION
- IF $GET(^PSRX(APCHSRXP,"STA"))=4
- QUIT
- +18 SET APCHSIG=""
- +19 SET APCHSIG=$PIECE($GET(APCHSN),U,5)
- +20 ;D ^BOMB ;get expanded sig
- DO SIG
- +21 ;days supply
- SET APCHSDYS=$PIECE($GET(APCHSN),U,7)
- +22 ;Q:APCHSDYS=1 ;quit if only 1 day supply
- +23 IF $GET(APCHSCOT)=1
- IF $GET(APCHSDYS)]""
- IF $$FMDIFF^XLFDT(DT,APCHSDTM)>$GET(APCHSDYS)
- QUIT
- +24 ;quit if qty=1
- IF $PIECE($GET(^AUPNVMED(APCHSMX,0)),U,6)=1
- QUIT
- +25 ;compare Drug File .01 field & V Med Name of Non Table Drug
- SET APCHSMFX=$PIECE(^PSDRUG(+APCHSN,0),U)
- Begin DoDot:1
- +26 IF $PIECE(APCHSN,U,4)=""
- QUIT
- +27 IF $PIECE($GET(APCHSN),U,4)]""
- IF $PIECE($GET(APCHSN),U,4)=$PIECE(^PSDRUG(+APCHSN,0),U)
- QUIT
- +28 IF $PIECE($GET(APCHSN),U,4)]""
- IF $PIECE($GET(APCHSN),U,4)'=$PIECE(^PSDRUG(+APCHSN,0),U)
- SET APCHSMFX=$PIECE(APCHSN,U,4)
- +29 QUIT
- End DoDot:1
- +30 ;quit if med already exists
- IF $GET(APCHSM(APCHSMFX))
- QUIT
- +31 ;PSDRUG ien^days supply
- SET APCHSM(APCHSMFX)=+APCHSN_U_APCHSDYS
- +32 ;^PSRX ien
- IF $GET(APCHSRXP)>0
- SET $PIECE(APCHSM(APCHSMFX),U,3)=APCHSRXP
- +33 ;status from RXSTAT
- SET $PIECE(APCHSM(APCHSMFX),U,4)=$GET(ST)
- +34 SET $PIECE(APCHSM(APCHSMFX),U,5)=$GET(APCHSSGY)
- +35 ;number of active meds
- SET APCHSMCT=APCHSMCT+1
- +36 QUIT
- +37 ;
- SIG ;CONSTRUCT THE FULL TEXT FROM THE ENCODED SIG
- +1 SET APCHSSGY=""
- FOR APCHSP=1:1:$LENGTH(APCHSIG," ")
- SET X=$PIECE(APCHSIG," ",APCHSP)
- IF X]""
- Begin DoDot:1
- +2 SET Y=$ORDER(^PS(51,"B",X,0))
- IF Y>0
- SET X=$PIECE(^PS(51,Y,0),"^",2)
- IF $DATA(^(9))
- SET Y=$PIECE(APCHSIG," ",APCHSP-1)
- SET Y=$EXTRACT(Y,$LENGTH(Y))
- IF Y>1
- SET X=$PIECE(^(9),"^",1)
- +3 SET APCHSSGY=APCHSSGY_X_" "
- End DoDot:1
- +4 QUIT
