- 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 Mar 13, 2025@21:38:15 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
