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;;
