PSSP176 ;DAL/RJS-PSS*1.0*176 PRE INSTALL ROUTINE
;;1.0;PHARMACY DATA MANAGEMENT;**176**;9/30/97;Build 3
;;
;;Reference to ^DDMOD is supported by DBIA# 2916.
;;
Q
PREINT ; PRE INSTALL ENTRY POINT.
D BMES^XPDUTL("PSS*1*176 PRE INSTALL STARTED!")
D DELIX^DDMOD(50,13,1),DELIX^DDMOD(50,15,1)
N PSSDRG,PSSNAME,PSSDEA,PSSNDC,PSSKEYN,PSSCNT,PSSTMP,PSSSITE,X1,X2,X
S X1=DT,X2=180 D C^%DTC S ^XTMP("PSSP176",0)=X_"^"_DT_"^PSDRUG NDCOP BACKUP" ;; STORE NDCOP DATA FOR 180 DAYS
K ^TMP("PSSDRUG",$J),^TMP("PSSTEXT",$J)
S (PSSDRG,PSSCNT)=0
F PSSDRG=0:0 S PSSDRG=$O(^PSDRUG(PSSDRG)) Q:'PSSDRG D CKDEA
D MAIL
K PSSDRG,PSSNAME,PSSDEA,PSSNDC,PSSKEYN,PSSCNT,PSSTMP,PSSSITE,PSSTXLN,PSSDSH,PSSDATA,XMTEXT
D BMES^XPDUTL("PSS*1*176 PRE INSTALL COMPLETE!")
Q
CKDEA ;Check each drug in the Drug file for non E PAYABLE drugs.
S PSSDEA=""
S PSSDEA=$$GET1^DIQ(50,PSSDRG,3)
I PSSDEA="" D CKNDC Q
I $G(PSSDEA)["M"!($G(PSSDEA)["0") D CKNDC Q
I $G(PSSDEA)'["E" D
.I $G(PSSDEA)["S"!($G(PSSDEA)["I")!($G(PSSDEA)["9") D CKNDC Q
Q
CKNDC ;If a drug is non e-billable remove the NDC BY OUTPATIENT SITE multiple from the drug file
Q:'$D(^PSDRUG(PSSDRG,"NDCOP",0))
I '$O(^PSDRUG(PSSDRG,"NDCOP",0)) K ^PSDRUG(PSSDRG,"NDCOP") Q
S PSSNAME=$$GET1^DIQ(50,PSSDRG,.01)
S PSSNDC=$$GET1^DIQ(50,PSSDRG,31)
I PSSNDC="" S PSSNDC="NO NDC"
I PSSDEA="" S PSSDEA="NO DEA"
S PSSCNT=PSSCNT+1
S ^TMP("PSSDRUG",$J,PSSCNT)=PSSDRG_"^"_$E(PSSNAME,1,40)_"^"_PSSNDC_"^"_PSSDEA D XTMP
K ^PSDRUG(PSSDRG,"NDCOP")
Q
MAIL ;Set up mail message
S XMDUZ="PSS*1*176 INCORRECT DRUG COST IN OUTPATIENT RX",XMSUB="WRONG NDC BY OUTPATIENT SITE"
F PSSKEYN=0:0 S PSSKEYN=$O(^XUSEC("PSNMGR",PSSKEYN)) Q:'PSSKEYN S XMY(PSSKEYN)=""
S XMY(DUZ)=""
S PSSDSH="",PSSCTR=0
F PSSCTR=1:1:79 S PSSDSH=PSSDSH_"-"
S ^TMP("PSSTEXT",$J,1)="The following is a list of drugs where the NDC by OUTPATIENT"
S ^TMP("PSSTEXT",$J,2)=" SITE multiple has been removed."
S ^TMP("PSSTEXT",$J,3)=""
S ^TMP("PSSTEXT",$J,4)="No action is needed to be taken on these entries, unless the assigned"
S ^TMP("PSSTEXT",$J,5)=" DEA Special Handling designation appears incorrect."
S ^TMP("PSSTEXT",$J,6)=""
S ^TMP("PSSTEXT",$J,7)="Total number of drug files modified = "_$S(PSSCNT=0:"(None modified)",1:PSSCNT)
S ^TMP("PSSTEXT",$J,8)=""
S PSSTXLN=9
I $D(^TMP("PSSDRUG",$J)) D
.S ^TMP("PSSTEXT",$J,PSSTXLN)="",PSSTXLN=PSSTXLN+1
.S ^TMP("PSSTEXT",$J,PSSTXLN)="DRUG IEN DEA",PSSTXLN=PSSTXLN+1
.S ^TMP("PSSTEXT",$J,PSSTXLN)=" GENERIC NAME NDC SPECIAL HDLG",PSSTXLN=PSSTXLN+1
.S ^TMP("PSSTEXT",$J,PSSTXLN)=PSSDSH,PSSTXLN=PSSTXLN+1
.F PSSCNT=0:0 S PSSCNT=$O(^TMP("PSSDRUG",$J,PSSCNT)) Q:'PSSCNT D
..S PSSDATA=$G(^TMP("PSSDRUG",$J,PSSCNT))
..S ^TMP("PSSTEXT",$J,PSSTXLN)=$P(PSSDATA,"^",1),PSSTXLN=PSSTXLN+1
..S PSSTXT="" D TXT($P(PSSDATA,"^",2),2),TXT($P(PSSDATA,"^",3),48),TXT($P(PSSDATA,"^",4),66)
..S ^TMP("PSSTEXT",$J,PSSTXLN)=PSSTXT,PSSTXLN=PSSTXLN+1
I '$D(^TMP("PSSDRUG",$J)) S ^TMP("PSSTEXT",$J,PSSTXLN)=PSSDSH,PSSTXLN=PSSTXLN+1
S ^TMP("PSSTEXT",$J,PSSTXLN)="",PSSTXLN=PSSTXLN+1,^TMP("PSSTEXT",$J,PSSTXLN)=" *** End of Report ***"
S XMTEXT="^TMP(""PSSTEXT"",$J," N DIFROM D ^XMD K XMSUB,XMTEST,XMY,XMDUZ
K ^TMP("PSSTEXT",$J),^TMP("PSSDRUG",$J),PSSTXT,PSSCTR
Q
TXT(PSSVAL,PSSCAL) S:'$D(PSSTXT) PSSTXT="" S PSSTXT=$$SETSTR^VALM1(PSSVAL,PSSTXT,PSSCAL,$L(PSSVAL))
Q
XTMP ; BUILD A BACKUP OF THE REMOVED DATA
N PSS1
S ^XTMP("PSSP176",PSSDRG,"NDCOP",0)=^PSDRUG(PSSDRG,"NDCOP",0)
S PSS1=0 F S PSS1=$O(^PSDRUG(PSSDRG,"NDCOP",PSS1)) Q:'PSS1 S ^XTMP("PSSP176",PSSDRG,"NDCOP",PSS1)=^PSDRUG(PSSDRG,"NDCOP",PSS1,0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSP176 3750 printed Nov 22, 2024@17:43:41 Page 2
PSSP176 ;DAL/RJS-PSS*1.0*176 PRE INSTALL ROUTINE
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**176**;9/30/97;Build 3
+2 ;;
+3 ;;Reference to ^DDMOD is supported by DBIA# 2916.
+4 ;;
+5 QUIT
PREINT ; PRE INSTALL ENTRY POINT.
+1 DO BMES^XPDUTL("PSS*1*176 PRE INSTALL STARTED!")
+2 DO DELIX^DDMOD(50,13,1)
DO DELIX^DDMOD(50,15,1)
+3 NEW PSSDRG,PSSNAME,PSSDEA,PSSNDC,PSSKEYN,PSSCNT,PSSTMP,PSSSITE,X1,X2,X
+4 ;; STORE NDCOP DATA FOR 180 DAYS
SET X1=DT
SET X2=180
DO C^%DTC
SET ^XTMP("PSSP176",0)=X_"^"_DT_"^PSDRUG NDCOP BACKUP"
+5 KILL ^TMP("PSSDRUG",$JOB),^TMP("PSSTEXT",$JOB)
+6 SET (PSSDRG,PSSCNT)=0
+7 FOR PSSDRG=0:0
SET PSSDRG=$ORDER(^PSDRUG(PSSDRG))
if 'PSSDRG
QUIT
DO CKDEA
+8 DO MAIL
+9 KILL PSSDRG,PSSNAME,PSSDEA,PSSNDC,PSSKEYN,PSSCNT,PSSTMP,PSSSITE,PSSTXLN,PSSDSH,PSSDATA,XMTEXT
+10 DO BMES^XPDUTL("PSS*1*176 PRE INSTALL COMPLETE!")
+11 QUIT
CKDEA ;Check each drug in the Drug file for non E PAYABLE drugs.
+1 SET PSSDEA=""
+2 SET PSSDEA=$$GET1^DIQ(50,PSSDRG,3)
+3 IF PSSDEA=""
DO CKNDC
QUIT
+4 IF $GET(PSSDEA)["M"!($GET(PSSDEA)["0")
DO CKNDC
QUIT
+5 IF $GET(PSSDEA)'["E"
Begin DoDot:1
+6 IF $GET(PSSDEA)["S"!($GET(PSSDEA)["I")!($GET(PSSDEA)["9")
DO CKNDC
QUIT
End DoDot:1
+7 QUIT
CKNDC ;If a drug is non e-billable remove the NDC BY OUTPATIENT SITE multiple from the drug file
+1 if '$DATA(^PSDRUG(PSSDRG,"NDCOP",0))
QUIT
+2 IF '$ORDER(^PSDRUG(PSSDRG,"NDCOP",0))
KILL ^PSDRUG(PSSDRG,"NDCOP")
QUIT
+3 SET PSSNAME=$$GET1^DIQ(50,PSSDRG,.01)
+4 SET PSSNDC=$$GET1^DIQ(50,PSSDRG,31)
+5 IF PSSNDC=""
SET PSSNDC="NO NDC"
+6 IF PSSDEA=""
SET PSSDEA="NO DEA"
+7 SET PSSCNT=PSSCNT+1
+8 SET ^TMP("PSSDRUG",$JOB,PSSCNT)=PSSDRG_"^"_$EXTRACT(PSSNAME,1,40)_"^"_PSSNDC_"^"_PSSDEA
DO XTMP
+9 KILL ^PSDRUG(PSSDRG,"NDCOP")
+10 QUIT
MAIL ;Set up mail message
+1 SET XMDUZ="PSS*1*176 INCORRECT DRUG COST IN OUTPATIENT RX"
SET XMSUB="WRONG NDC BY OUTPATIENT SITE"
+2 FOR PSSKEYN=0:0
SET PSSKEYN=$ORDER(^XUSEC("PSNMGR",PSSKEYN))
if 'PSSKEYN
QUIT
SET XMY(PSSKEYN)=""
+3 SET XMY(DUZ)=""
+4 SET PSSDSH=""
SET PSSCTR=0
+5 FOR PSSCTR=1:1:79
SET PSSDSH=PSSDSH_"-"
+6 SET ^TMP("PSSTEXT",$JOB,1)="The following is a list of drugs where the NDC by OUTPATIENT"
+7 SET ^TMP("PSSTEXT",$JOB,2)=" SITE multiple has been removed."
+8 SET ^TMP("PSSTEXT",$JOB,3)=""
+9 SET ^TMP("PSSTEXT",$JOB,4)="No action is needed to be taken on these entries, unless the assigned"
+10 SET ^TMP("PSSTEXT",$JOB,5)=" DEA Special Handling designation appears incorrect."
+11 SET ^TMP("PSSTEXT",$JOB,6)=""
+12 SET ^TMP("PSSTEXT",$JOB,7)="Total number of drug files modified = "_$SELECT(PSSCNT=0:"(None modified)",1:PSSCNT)
+13 SET ^TMP("PSSTEXT",$JOB,8)=""
+14 SET PSSTXLN=9
+15 IF $DATA(^TMP("PSSDRUG",$JOB))
Begin DoDot:1
+16 SET ^TMP("PSSTEXT",$JOB,PSSTXLN)=""
SET PSSTXLN=PSSTXLN+1
+17 SET ^TMP("PSSTEXT",$JOB,PSSTXLN)="DRUG IEN DEA"
SET PSSTXLN=PSSTXLN+1
+18 SET ^TMP("PSSTEXT",$JOB,PSSTXLN)=" GENERIC NAME NDC SPECIAL HDLG"
SET PSSTXLN=PSSTXLN+1
+19 SET ^TMP("PSSTEXT",$JOB,PSSTXLN)=PSSDSH
SET PSSTXLN=PSSTXLN+1
+20 FOR PSSCNT=0:0
SET PSSCNT=$ORDER(^TMP("PSSDRUG",$JOB,PSSCNT))
if 'PSSCNT
QUIT
Begin DoDot:2
+21 SET PSSDATA=$GET(^TMP("PSSDRUG",$JOB,PSSCNT))
+22 SET ^TMP("PSSTEXT",$JOB,PSSTXLN)=$PIECE(PSSDATA,"^",1)
SET PSSTXLN=PSSTXLN+1
+23 SET PSSTXT=""
DO TXT($PIECE(PSSDATA,"^",2),2)
DO TXT($PIECE(PSSDATA,"^",3),48)
DO TXT($PIECE(PSSDATA,"^",4),66)
+24 SET ^TMP("PSSTEXT",$JOB,PSSTXLN)=PSSTXT
SET PSSTXLN=PSSTXLN+1
End DoDot:2
End DoDot:1
+25 IF '$DATA(^TMP("PSSDRUG",$JOB))
SET ^TMP("PSSTEXT",$JOB,PSSTXLN)=PSSDSH
SET PSSTXLN=PSSTXLN+1
+26 SET ^TMP("PSSTEXT",$JOB,PSSTXLN)=""
SET PSSTXLN=PSSTXLN+1
SET ^TMP("PSSTEXT",$JOB,PSSTXLN)=" *** End of Report ***"
+27 SET XMTEXT="^TMP(""PSSTEXT"",$J,"
NEW DIFROM
DO ^XMD
KILL XMSUB,XMTEST,XMY,XMDUZ
+28 KILL ^TMP("PSSTEXT",$JOB),^TMP("PSSDRUG",$JOB),PSSTXT,PSSCTR
+29 QUIT
TXT(PSSVAL,PSSCAL) if '$DATA(PSSTXT)
SET PSSTXT=""
SET PSSTXT=$$SETSTR^VALM1(PSSVAL,PSSTXT,PSSCAL,$LENGTH(PSSVAL))
+1 QUIT
XTMP ; BUILD A BACKUP OF THE REMOVED DATA
+1 NEW PSS1
+2 SET ^XTMP("PSSP176",PSSDRG,"NDCOP",0)=^PSDRUG(PSSDRG,"NDCOP",0)
+3 SET PSS1=0
FOR
SET PSS1=$ORDER(^PSDRUG(PSSDRG,"NDCOP",PSS1))
if 'PSS1
QUIT
SET ^XTMP("PSSP176",PSSDRG,"NDCOP",PSS1)=^PSDRUG(PSSDRG,"NDCOP",PSS1,0)
+4 QUIT
