BTIULO10.m

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)