APSPPPIO.m

APSPPPIO ;IHS/CIA/PLS - Return PMI information ;03-Nov-2004 21:32;PLS

 ;;7.0; IHS PHARMACY MODIFICATIONS;**1001**;MAR 2, 2004

 ; This is a modified version of PSNPPIO

 ; Modified - IHS/CIA/PLS - 11/03/04 - EN+19

EN(PSNDRUG,PSNMSG) ; EP

 ;

 ; entry point from Outpatient Pharmacy Labels

 ; Calling method: S PSNFLAG=$$EN^APSPPPIO(PSNDRUG)

 ;

 ; Input: PSNDRUG = IFN from the DRUG file (50)  ** REQUIRED **

 ;

 ; Output: PSNFLAG = 0 if no PMI returned

 ;                   1 if PMI returned in ^TMP($J,"PSNPMI"

 ;         PSNMSG  = message text for no PMI information

 ;

 N PSNFLAG,PSNPN,PSNGCN,A1,PSNFILE1,PSNFILE2,PSNEMAP,PMID,PSNPL,I

 N MAP,LP,TXT,MTBL,XX,PMAP

 K ^TMP($J,"PSNPMI")

 S PSNFLAG=1,(MAP,PMAP,XX)=""

 S PSNPN=$TR($P($G(^PSDRUG(PSNDRUG,2)),U,4),"-")   ; NDC

 I 'PSNPN S PSNMSG="This drug is not matched to the National Drug File; therefore, a Medication Information Sheet cannot be printed." Q 0

 S PSNGCN=$O(^APSAMDF("B",PSNPN,0))

 I 'PSNGCN S PSNMSG="This drug is not linked to a Medication Information Sheet." Q 0

 ;S PSNGCN=+$G(^APSAMDF(PSNGCN,3)) ; IHS/CIA/PLS - 11/03/04

 S PSNGCN=$G(^APSAMDF(PSNGCN,3))   ; '+' removed

 I 'PSNGCN!'$D(^APSAPPI(PSNGCN)) S PSNMSG="This drug is not linked to a Medication Information Sheet." Q 0

 D SETMTBL(.MTBL)

 S ^TMP($J,"PSNPMI",0)=$G(^APSAPPI(PSNGCN,0))

 S LP=0 F  S LP=$O(^APSAPPI(PSNGCN,1,LP)) Q:'LP  D

 .S TXT=$G(^APSAPPI(PSNGCN,1,LP,0)),XX=""

 .I $$GETMAP(TXT,.MAP,.XX) D

 ..I $L(XX) D

 ...D SETTXT(XX,PMAP)

 ...D SETTXT($P(TXT,XX,2),MAP)

 ...S XX=""

 ..E  D SETTXT(TXT,MAP)

 ..S PMAP=MAP

 .E  D

 ..D SETTXT(TXT,MAP)

 D ADDDISC  ; Add disclaimer text

 Q 1

 ; Set text into global

SETTXT(TEXT,SUB) ;

 Q:SUB=""

 S ^TMP($J,"PSNPMI",SUB,+$G(MTBL(SUB)),0)=$$TRIM^XLFSTR(TEXT,"R")

 S MTBL(SUB)=MTBL(SUB)+1

 Q

 ; Return mapping type

GETMAP(TEXT,MAP,XX) ;

 N L,LBL,FLG

 S FLG=0

 F L=1:1 S LBL=$P($T(MAP+L),";;",2,3) Q:LBL=""  D  Q:FLG

 .I TEXT[$P(LBL,";;")_":" D

 ..S MAP=$P(LBL,";;",2),FLG=1

 ..S XX=$P(TEXT,$P(LBL,";;")_":")

 Q FLG

 ; Setup Map Table Counts

SETMTBL(DAT) ;

 N L,KEY

 F L=1:1 S LBL=$P($T(MAP+L),";;",2,3) Q:LBL=""  D

 .S DAT($P(LBL,";;",2))=1

 Q

 ; Add Disclaimer Text to "T" subscript of global

ADDDISC ;

 N LP,TXT

 S LP=0

 S TXT=$$TRIM^XLFSTR($P(^APSAPPI(.5,0),U,1),"R")

 S TXT="DISCLAIMER: "_TXT_"  Expires "_$$FMTE^XLFDT($$HL7TFM^XLFDT($P(^APSAPPI(.5,0),U,5))\100*100,"1D")_"."

 D SETTXT(TXT,"T")

 F  S LP=$O(^APSAPPI(.5,2,LP)) Q:'LP  D

 .D SETTXT(^APSAPPI(.5,2,LP,0),"T")

 S LP=0 F  S LP=$O(^APSAPPI(.5,3,LP)) Q:'LP  D

 .D SETTXT(^APSAPPI(.5,3,LP,0),"T")

 Q

 ; Key words

MAP ;;

 ;;GENERIC NAME;;G;;

 ;;COMMON USES;;U;;

 ;;HOW TO USE THIS MEDICINE;;H;;

 ;;CAUTIONS;;C;;

 ;;POSSIBLE SIDE EFFECTS;;S;;

 ;;BEFORE USING THIS MEDICINE;;B;;

 ;;OVERDOSE;;O;;

 ;;ADDITIONAL INFORMATION;;I;;

 ;;DISCLAIMER;;T;;

APSPPPIO  ;IHS/CIA/PLS - Return PMI information ;03-Nov-2004 21:32;PLS

 +1       ;;7.0; IHS PHARMACY MODIFICATIONS;**1001**;MAR 2, 2004

 +2       ; This is a modified version of PSNPPIO

 +3       ; Modified - IHS/CIA/PLS - 11/03/04 - EN+19

EN(PSNDRUG,PSNMSG) ; EP

 +1       ;

 +2       ; entry point from Outpatient Pharmacy Labels

 +3       ; Calling method: S PSNFLAG=$$EN^APSPPPIO(PSNDRUG)

 +4       ;

 +5       ; Input: PSNDRUG = IFN from the DRUG file (50)  ** REQUIRED **

 +6       ;

 +7       ; Output: PSNFLAG = 0 if no PMI returned

 +8       ;                   1 if PMI returned in ^TMP($J,"PSNPMI"

 +9       ;         PSNMSG  = message text for no PMI information

 +10      ;

 +11       NEW PSNFLAG,PSNPN,PSNGCN,A1,PSNFILE1,PSNFILE2,PSNEMAP,PMID,PSNPL,I

 +12       NEW MAP,LP,TXT,MTBL,XX,PMAP

 +13       KILL ^TMP($JOB,"PSNPMI")

 +14       SET PSNFLAG=1

           SET (MAP,PMAP,XX)=""

 +15      ; NDC

           SET PSNPN=$TRANSLATE($PIECE($GET(^PSDRUG(PSNDRUG,2)),U,4),"-")

 +16       IF 'PSNPN

               SET PSNMSG="This drug is not matched to the National Drug File; therefore, a Medication Information Sheet cannot be printed."

               QUIT 0

 +17       SET PSNGCN=$ORDER(^APSAMDF("B",PSNPN,0))

 +18       IF 'PSNGCN

               SET PSNMSG="This drug is not linked to a Medication Information Sheet."

               QUIT 0

 +19      ;S PSNGCN=+$G(^APSAMDF(PSNGCN,3)) ; IHS/CIA/PLS - 11/03/04

 +20      ; '+' removed

           SET PSNGCN=$GET(^APSAMDF(PSNGCN,3))

 +21       IF 'PSNGCN!'$DATA(^APSAPPI(PSNGCN))

               SET PSNMSG="This drug is not linked to a Medication Information Sheet."

               QUIT 0

 +22       DO SETMTBL(.MTBL)

 +23       SET ^TMP($JOB,"PSNPMI",0)=$GET(^APSAPPI(PSNGCN,0))

 +24       SET LP=0

           FOR 

               SET LP=$ORDER(^APSAPPI(PSNGCN,1,LP))

               IF 'LP

                   QUIT 

               Begin DoDot:1

 +25               SET TXT=$GET(^APSAPPI(PSNGCN,1,LP,0))

                   SET XX=""

 +26               IF $$GETMAP(TXT,.MAP,.XX)

                       Begin DoDot:2

 +27                       IF $LENGTH(XX)

                               Begin DoDot:3

 +28                               DO SETTXT(XX,PMAP)

 +29                               DO SETTXT($PIECE(TXT,XX,2),MAP)

 +30                               SET XX=""

                               End DoDot:3

 +31                      IF '$TEST

                               DO SETTXT(TXT,MAP)

 +32                       SET PMAP=MAP

                       End DoDot:2

 +33              IF '$TEST

                       Begin DoDot:2

 +34                       DO SETTXT(TXT,MAP)

                       End DoDot:2

               End DoDot:1

 +35      ; Add disclaimer text

           DO ADDDISC

 +36       QUIT 1

 +37      ; Set text into global

SETTXT(TEXT,SUB) ;

 +1        IF SUB=""

               QUIT 

 +2        SET ^TMP($JOB,"PSNPMI",SUB,+$GET(MTBL(SUB)),0)=$$TRIM^XLFSTR(TEXT,"R")

 +3        SET MTBL(SUB)=MTBL(SUB)+1

 +4        QUIT 

 +5       ; Return mapping type

GETMAP(TEXT,MAP,XX) ;

 +1        NEW L,LBL,FLG

 +2        SET FLG=0

 +3        FOR L=1:1

               SET LBL=$PIECE($TEXT(MAP+L),";;",2,3)

               IF LBL=""

                   QUIT 

               Begin DoDot:1

 +4                IF TEXT[$PIECE(LBL,";;")_":"

                       Begin DoDot:2

 +5                        SET MAP=$PIECE(LBL,";;",2)

                           SET FLG=1

 +6                        SET XX=$PIECE(TEXT,$PIECE(LBL,";;")_":")

                       End DoDot:2

               End DoDot:1

               IF FLG

                   QUIT 

 +7        QUIT FLG

 +8       ; Setup Map Table Counts

SETMTBL(DAT) ;

 +1        NEW L,KEY

 +2        FOR L=1:1

               SET LBL=$PIECE($TEXT(MAP+L),";;",2,3)

               IF LBL=""

                   QUIT 

               Begin DoDot:1

 +3                SET DAT($PIECE(LBL,";;",2))=1

               End DoDot:1

 +4        QUIT 

 +5       ; Add Disclaimer Text to "T" subscript of global

ADDDISC   ;

 +1        NEW LP,TXT

 +2        SET LP=0

 +3        SET TXT=$$TRIM^XLFSTR($PIECE(^APSAPPI(.5,0),U,1),"R")

 +4        SET TXT="DISCLAIMER: "_TXT_"  Expires "_$$FMTE^XLFDT($$HL7TFM^XLFDT($PIECE(^APSAPPI(.5,0),U,5))\100*100,"1D")_"."

 +5        DO SETTXT(TXT,"T")

 +6        FOR 

               SET LP=$ORDER(^APSAPPI(.5,2,LP))

               IF 'LP

                   QUIT 

               Begin DoDot:1

 +7                DO SETTXT(^APSAPPI(.5,2,LP,0),"T")

               End DoDot:1

 +8        SET LP=0

           FOR 

               SET LP=$ORDER(^APSAPPI(.5,3,LP))

               IF 'LP

                   QUIT 

               Begin DoDot:1

 +9                DO SETTXT(^APSAPPI(.5,3,LP,0),"T")

               End DoDot:1

 +10       QUIT 

 +11      ; Key words

MAP       ;;

 +1       ;;GENERIC NAME;;G;;

 +2       ;;COMMON USES;;U;;

 +3       ;;HOW TO USE THIS MEDICINE;;H;;

 +4       ;;CAUTIONS;;C;;

 +5       ;;POSSIBLE SIDE EFFECTS;;S;;

 +6       ;;BEFORE USING THIS MEDICINE;;B;;

 +7       ;;OVERDOSE;;O;;

 +8       ;;ADDITIONAL INFORMATION;;I;;

 +9       ;;DISCLAIMER;;T;;