BTIULO10 ; MSC/IHS/MGH - Outside Meds ;10-Mar-2014 15:24;DU
;;1.0;TEXT INTEGRATION UTILITIES;**1006,1013**;NOV 04, 2004;Build 33
Q
;
; Created Outside med object
;
ACTHMMD(DFN) ; EP Logic taken from PSOP2 retrieve non-VA meds
;
N TITLE
S TITLE=$$GET^XPAR("ALL","BEHORX NONVA LABEL")
Q:$G(DFN)="" "No DFN"
Q:'$D(^DPT(DFN,0)) "No patient"
Q:'$O(^PS(55,DFN,"NVA",0)) "No "_TITLE_" Medications"
N HOMMD,CNT,MCNT,OUTMED,PPP,NVA,NVAOR,PCNT
K PQT S CNT=0,PCNT=1
K ^TMP($J,"ACTIVE-OUTSIDE-MEDS")
S HOMMD="^TMP($J,""ACTIVE-OUTSIDE-MEDS"")"
S CNT=CNT+1
S @HOMMD@(CNT,0)=" Active "_TITLE_" Medications"
S CNT=CNT+1
S @HOMMD@(CNT,0)="==============================================="
S MCNT=0
F PPP=0:0 S PPP=$O(^PS(55,DFN,"NVA",PPP)) Q:'PPP!($G(PQT)) S NVAOR=^PS(55,DFN,"NVA",PPP,0),NVA=1 D
.;
.Q:'$P(NVAOR,"^")
.Q:$P(NVAOR,"^",7)
.S MCNT=MCNT+1
.S OUTMED=MCNT_") "_$S($P(NVAOR,"^",2):$P($G(^PSDRUG(+$P(NVAOR,"^",2),0)),"^"),1:$P($G(^PS(50.7,$P(NVAOR,"^"),0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^"))
.S OUTMED=OUTMED_" Date Documented: "_$E($P(NVAOR,"^",10),4,5)_"/"_$E($P(NVAOR,"^",10),6,7)_"/"_$E($P(NVAOR,"^",10),2,3)
.S CNT=CNT+1,@HOMMD@(CNT,0)=OUTMED
.I $P(NVAOR,"^",3)'="" S CNT=CNT+1,@HOMMD@(CNT,0)=" Dosage: "_$P(NVAOR,"^",3)_$S($P(NVAOR,"^",5)'="":", Schedule: "_$P(NVAOR,"^",5),1:" ")
.;S CNT=CNT+1,@HOMMD@(CNT,0)="Status: "_$S($P(NVAOR,"^",7):"Discontinued ("_$E($P(NVAOR,"^",7),4,5)_"/"_$E($P(NVAOR,"^",7),6,7)_"/"_$E($P(NVAOR,"^",7),2,3)_")",1:"Active")
.;S CNT=CNT+1,@HOMMD@(CNT,0)=" "
.Q
I $D(^TMP($J,"ACTIVE-OUTSIDE-MEDS",4)) Q "~@"_$NA(@HOMMD)
E Q "No "_TITLE_" Meds"
Q
;
; *****************************
; removes trailing spaces from text
; i.e : "have a nice daysssss"
; result: "have a nice day"
;
STRIP(TXT) ;
N MSCNT
Q:$L(TXT)<2 ""
F MSCNT=46:-1:1 Q:$E(TXT,MSCNT)'=" " D
. S TXT=$E(TXT,1,$L(TXT)-1)
Q TXT
PAPWC(DFN,TARGET) ;EP; -- returns last pap date and result and result text
N N,Y,BW,DATE,LINE,L
S CNT=0
I $P(^DPT(DFN,0),U,2)="M" Q ""
S N=0 F S N=$O(^BWPCD("C",DFN,N)) Q:'N D
.S Y=$G(^BWPCD(N,0))
.I $P(Y,U,4)=1 S DATE=$P(Y,U,12) D
..S BW("PAP",9999999-DATE)=DATE_U_$P(Y,U,5)_U_N
I '$D(BW("PAP")) Q "No PAP on record"
S N=$O(BW("PAP",0)) I 'N Q "No PAP on record"
S N=BW("PAP",N)
S LINE="Last PAP: "_$$FMTE^XLFDT(+N,"5D")
S LINE=LINE_" Result - "_$$GET1^DIQ(9002086.31,$P(N,U,2),.01)
S LINE=LINE_" ("_$$GET1^DIQ(9002086.1,$P(N,U,3),.14)_")"
S CNT=CNT+1
S @TARGET@(CNT,0)=LINE
N WP,IENS,LINE
S IENS=$P(N,U,3)_","
S WP=$$GET1^DIQ(9002086.1,IENS,1.01,"Z","WP")
S L=0
F S L=$O(WP(L)) Q:L="" D
.S CNT=CNT+1
.S LINE=$G(WP(L,0))
.I L=1 S LINE="Results: "_LINE
.S @TARGET@(CNT,0)=LINE
Q "~@"_$NA(@TARGET)
BTIULO10 ; MSC/IHS/MGH - Outside Meds ;10-Mar-2014 15:24;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1006,1013**;NOV 04, 2004;Build 33
+2 QUIT
+3 ;
+4 ; Created Outside med object
+5 ;
ACTHMMD(DFN) ; EP Logic taken from PSOP2 retrieve non-VA meds
+1 ;
+2 NEW TITLE
+3 SET TITLE=$$GET^XPAR("ALL","BEHORX NONVA LABEL")
+4 IF $GET(DFN)=""
QUIT "No DFN"
+5 IF '$DATA(^DPT(DFN,0))
QUIT "No patient"
+6 IF '$ORDER(^PS(55,DFN,"NVA",0))
QUIT "No "_TITLE_" Medications"
+7 NEW HOMMD,CNT,MCNT,OUTMED,PPP,NVA,NVAOR,PCNT
+8 KILL PQT
SET CNT=0
SET PCNT=1
+9 KILL ^TMP($JOB,"ACTIVE-OUTSIDE-MEDS")
+10 SET HOMMD="^TMP($J,""ACTIVE-OUTSIDE-MEDS"")"
+11 SET CNT=CNT+1
+12 SET @HOMMD@(CNT,0)=" Active "_TITLE_" Medications"
+13 SET CNT=CNT+1
+14 SET @HOMMD@(CNT,0)="==============================================="
+15 SET MCNT=0
+16 FOR PPP=0:0
SET PPP=$ORDER(^PS(55,DFN,"NVA",PPP))
IF 'PPP!($GET(PQT))
QUIT
SET NVAOR=^PS(55,DFN,"NVA",PPP,0)
SET NVA=1
Begin DoDot:1
+17 ;
+18 IF '$PIECE(NVAOR,"^")
QUIT
+19 IF $PIECE(NVAOR,"^",7)
QUIT
+20 SET MCNT=MCNT+1
+21 SET OUTMED=MCNT_") "_$SELECT($PIECE(NVAOR,"^",2):$PIECE($GET(^PSDRUG(+$PIECE(NVAOR,"^",2),0)),"^"),1:$PIECE($GET(^PS(50.7,$PIECE(NVAOR,"^"),0)),"^")_" "_$PIECE($GET(^PS(50.606,+$PIECE($GET(^(0)),"^",2),0)),"^"))
+22 SET OUTMED=OUTMED_" Date Documented: "_$EXTRACT($PIECE(NVAOR,"^",10),4,5)_"/"_$EXTRACT($PIECE(NVAOR,"^",10),6,7)_"/"_$EXTRACT($PIECE(NVAOR,"^",10),2,3)
+23 SET CNT=CNT+1
SET @HOMMD@(CNT,0)=OUTMED
+24 IF $PIECE(NVAOR,"^",3)'=""
SET CNT=CNT+1
SET @HOMMD@(CNT,0)=" Dosage: "_$PIECE(NVAOR,"^",3)_$SELECT($PIECE(NVAOR,"^",5)'="":", Schedule: "_$PIECE(NVAOR,"^",5),1:" ")
+25 ;S CNT=CNT+1,@HOMMD@(CNT,0)="Status: "_$S($P(NVAOR,"^",7):"Discontinued ("_$E($P(NVAOR,"^",7),4,5)_"/"_$E($P(NVAOR,"^",7),6,7)_"/"_$E($P(NVAOR,"^",7),2,3)_")",1:"Active")
+26 ;S CNT=CNT+1,@HOMMD@(CNT,0)=" "
+27 QUIT
End DoDot:1
+28 IF $DATA(^TMP($JOB,"ACTIVE-OUTSIDE-MEDS",4))
QUIT "~@"_$NAME(@HOMMD)
+29 IF '$TEST
QUIT "No "_TITLE_" Meds"
+30 QUIT
+31 ;
+32 ; *****************************
+33 ; removes trailing spaces from text
+34 ; i.e : "have a nice daysssss"
+35 ; result: "have a nice day"
+36 ;
STRIP(TXT) ;
+1 NEW MSCNT
+2 IF $LENGTH(TXT)<2
QUIT ""
+3 FOR MSCNT=46:-1:1
IF $EXTRACT(TXT,MSCNT)'=" "
QUIT
Begin DoDot:1
+4 SET TXT=$EXTRACT(TXT,1,$LENGTH(TXT)-1)
End DoDot:1
+5 QUIT TXT
PAPWC(DFN,TARGET) ;EP; -- returns last pap date and result and result text
+1 NEW N,Y,BW,DATE,LINE,L
+2 SET CNT=0
+3 IF $PIECE(^DPT(DFN,0),U,2)="M"
QUIT ""
+4 SET N=0
FOR
SET N=$ORDER(^BWPCD("C",DFN,N))
IF 'N
QUIT
Begin DoDot:1
+5 SET Y=$GET(^BWPCD(N,0))
+6 IF $PIECE(Y,U,4)=1
SET DATE=$PIECE(Y,U,12)
Begin DoDot:2
+7 SET BW("PAP",9999999-DATE)=DATE_U_$PIECE(Y,U,5)_U_N
End DoDot:2
End DoDot:1
+8 IF '$DATA(BW("PAP"))
QUIT "No PAP on record"
+9 SET N=$ORDER(BW("PAP",0))
IF 'N
QUIT "No PAP on record"
+10 SET N=BW("PAP",N)
+11 SET LINE="Last PAP: "_$$FMTE^XLFDT(+N,"5D")
+12 SET LINE=LINE_" Result - "_$$GET1^DIQ(9002086.31,$PIECE(N,U,2),.01)
+13 SET LINE=LINE_" ("_$$GET1^DIQ(9002086.1,$PIECE(N,U,3),.14)_")"
+14 SET CNT=CNT+1
+15 SET @TARGET@(CNT,0)=LINE
+16 NEW WP,IENS,LINE
+17 SET IENS=$PIECE(N,U,3)_","
+18 SET WP=$$GET1^DIQ(9002086.1,IENS,1.01,"Z","WP")
+19 SET L=0
+20 FOR
SET L=$ORDER(WP(L))
IF L=""
QUIT
Begin DoDot:1
+21 SET CNT=CNT+1
+22 SET LINE=$GET(WP(L,0))
+23 IF L=1
SET LINE="Results: "_LINE
+24 SET @TARGET@(CNT,0)=LINE
End DoDot:1
+25 QUIT "~@"_$NAME(@TARGET)
