PSS208P ; ALB/MHA - Price per dispense unit - post install fix ;05/24/2017
;;1.0;PHARMACY DATA MANAGEMENT;**208**;9/30/97;Build 14
;
Q
;
EN ;
D BMES^XPDUTL("Starting post-install for PSS*1*208 ... ")
D DRG
D MES^XPDUTL("Finished with post-install for PSS*1*208.")
Q
;
DRG ; loop through DRUG file for price update
N NS,DRG,NDC,PPDU,PPOU,CT S DRG=0,NS="PSS208" K ^TMP(NS,$J)
S ^TMP(NS,$J,1)="The Price Per Dispense Unit (PPDU) field (#16) and the Price Per Order Unit"
S ^TMP(NS,$J,2)="(PPOU) field (#13) in the Drug file (#50) have been updated in the following"
S ^TMP(NS,$J,3)="entries:"
S ^TMP(NS,$J,4)=""
S ^TMP(NS,$J,5)="Generic Name"
S $E(^TMP(NS,$J,5),44)="NDC Old PPDU New PPDU"
S $E(^TMP(NS,$J,6),44)=" PPOU PPOU"
S ^TMP(NS,$J,7)="============"
S $E(^TMP(NS,$J,7),44)="=== ======== ========"
S ^TMP(NS,$J,8)="",CT=8
F S DRG=$O(^PSDRUG(DRG)) Q:'DRG D
. S NDC=$P($G(^PSDRUG(DRG,2)),"^",4),PPDU=$J($P($G(^PSDRUG(DRG,660)),"^",6),0,4),PPOU=$J($P($G(^PSDRUG(DRG,660)),"^",3),0,2) D:$G(NDC)
. . N I,SYN,SNDC,SPPDU,SINT,SOU,SPPOU,SDUOU,QT S (I,QT)=0
. . F S I=$O(^PSDRUG(DRG,1,I)) Q:'I!(QT) D
. . . S SYN=^PSDRUG(DRG,1,I,0),SNDC=$P(SYN,"^",2),SPPDU=$J($P(SYN,"^",8),0,4),SINT=$P(SYN,"^",3) Q:SINT'["D"!('SPPDU) ;SYN Price per dispense unit
. . . S:$E(SNDC)=0 $P(SNDC,"-")=+$P(SNDC,"-")
. . . S:$E(NDC)=0 $P(NDC,"-")=+$P(NDC,"-")
. . . I $G(SNDC),SNDC=NDC,SPPDU>221,SPPDU'=PPDU D FIXPR S QT=1
D GMAIL
Q
;
FIXPR ;
S SOU=$P(SYN,"^",5) ; Order unit
S SPPOU=$P(SYN,"^",6) ;Price per order unit
S SDUOU=$P(SYN,"^",7) ;Dispense Units per Order Unit
N DIE,DA,DR
S DIE="^PSDRUG(",DA=DRG,DR="12////"_SOU_";13////"_SPPOU_";15////"_SDUOU_";16////"_SPPDU D ^DIE
S CT=CT+1,^TMP(NS,$J,CT)=$E($P(^PSDRUG(DRG,0),"^"),1,35)_"("_DRG_")"
S $E(^TMP(NS,$J,CT),44)=NDC,$E(^TMP(NS,$J,CT),59)=$J(PPDU,8,2),$E(^TMP(NS,$J,CT),70)=$J(SPPDU,8,2)
S CT=CT+1
S $E(^TMP(NS,$J,CT),59)=$J(PPOU,8,2),$E(^TMP(NS,$J,CT),70)=$J(SPPOU,8,2)
Q
;
GMAIL ; send post-install message
S XMSUB="PSS*1*208 Post-Install Drug Price Update Report"
S XMDUZ="PHARMACY DATA MANAGEMENT PACKAGE",XMY(DUZ)=""
I $D(^XUSEC("PSNMGR")) S PSSDUZ=0 F S PSSDUZ=$O(^XUSEC("PSNMGR",PSSDUZ)) Q:'PSSDUZ S XMY(PSSDUZ)=""
I $D(^XUSEC("PSA ORDERS")) S PSSDUZ=0 F S PSSDUZ=$O(^XUSEC("PSA ORDERS",PSSDUZ)) Q:'PSSDUZ S XMY(PSSDUZ)=""
I $D(^XUSEC("PSAMGR")) S PSSDUZ=0 F S PSSDUZ=$O(^XUSEC("PSDMGR",PSSDUZ)) Q:'PSSDUZ S XMY(PSSDUZ)=""
I CT=8 S ^TMP(NS,$J,7)="No discrepancy found, nothing to update..."
S XMTEXT="^TMP(""PSS208"",$J," N DIFROM D ^XMD
K XMSUB,XMDUZ,XMY,XMTEXT,PSSDUZ,^TMP(NS,$J)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS208P 2694 printed Apr 09, 2024@21:37:15 Page 2
PSS208P ; ALB/MHA - Price per dispense unit - post install fix ;05/24/2017
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**208**;9/30/97;Build 14
+2 ;
+3 QUIT
+4 ;
EN ;
+1 DO BMES^XPDUTL("Starting post-install for PSS*1*208 ... ")
+2 DO DRG
+3 DO MES^XPDUTL("Finished with post-install for PSS*1*208.")
+4 QUIT
+5 ;
DRG ; loop through DRUG file for price update
+1 NEW NS,DRG,NDC,PPDU,PPOU,CT
SET DRG=0
SET NS="PSS208"
KILL ^TMP(NS,$JOB)
+2 SET ^TMP(NS,$JOB,1)="The Price Per Dispense Unit (PPDU) field (#16) and the Price Per Order Unit"
+3 SET ^TMP(NS,$JOB,2)="(PPOU) field (#13) in the Drug file (#50) have been updated in the following"
+4 SET ^TMP(NS,$JOB,3)="entries:"
+5 SET ^TMP(NS,$JOB,4)=""
+6 SET ^TMP(NS,$JOB,5)="Generic Name"
+7 SET $EXTRACT(^TMP(NS,$JOB,5),44)="NDC Old PPDU New PPDU"
+8 SET $EXTRACT(^TMP(NS,$JOB,6),44)=" PPOU PPOU"
+9 SET ^TMP(NS,$JOB,7)="============"
+10 SET $EXTRACT(^TMP(NS,$JOB,7),44)="=== ======== ========"
+11 SET ^TMP(NS,$JOB,8)=""
SET CT=8
+12 FOR
SET DRG=$ORDER(^PSDRUG(DRG))
if 'DRG
QUIT
Begin DoDot:1
+13 SET NDC=$PIECE($GET(^PSDRUG(DRG,2)),"^",4)
SET PPDU=$JUSTIFY($PIECE($GET(^PSDRUG(DRG,660)),"^",6),0,4)
SET PPOU=$JUSTIFY($PIECE($GET(^PSDRUG(DRG,660)),"^",3),0,2)
if $GET(NDC)
Begin DoDot:2
+14 NEW I,SYN,SNDC,SPPDU,SINT,SOU,SPPOU,SDUOU,QT
SET (I,QT)=0
+15 FOR
SET I=$ORDER(^PSDRUG(DRG,1,I))
if 'I!(QT)
QUIT
Begin DoDot:3
+16 ;SYN Price per dispense unit
SET SYN=^PSDRUG(DRG,1,I,0)
SET SNDC=$PIECE(SYN,"^",2)
SET SPPDU=$JUSTIFY($PIECE(SYN,"^",8),0,4)
SET SINT=$PIECE(SYN,"^",3)
if SINT'["D"!('SPPDU)
QUIT
+17 if $EXTRACT(SNDC)=0
SET $PIECE(SNDC,"-")=+$PIECE(SNDC,"-")
+18 if $EXTRACT(NDC)=0
SET $PIECE(NDC,"-")=+$PIECE(NDC,"-")
+19 IF $GET(SNDC)
IF SNDC=NDC
IF SPPDU>221
IF SPPDU'=PPDU
DO FIXPR
SET QT=1
End DoDot:3
End DoDot:2
End DoDot:1
+20 DO GMAIL
+21 QUIT
+22 ;
FIXPR ;
+1 ; Order unit
SET SOU=$PIECE(SYN,"^",5)
+2 ;Price per order unit
SET SPPOU=$PIECE(SYN,"^",6)
+3 ;Dispense Units per Order Unit
SET SDUOU=$PIECE(SYN,"^",7)
+4 NEW DIE,DA,DR
+5 SET DIE="^PSDRUG("
SET DA=DRG
SET DR="12////"_SOU_";13////"_SPPOU_";15////"_SDUOU_";16////"_SPPDU
DO ^DIE
+6 SET CT=CT+1
SET ^TMP(NS,$JOB,CT)=$EXTRACT($PIECE(^PSDRUG(DRG,0),"^"),1,35)_"("_DRG_")"
+7 SET $EXTRACT(^TMP(NS,$JOB,CT),44)=NDC
SET $EXTRACT(^TMP(NS,$JOB,CT),59)=$JUSTIFY(PPDU,8,2)
SET $EXTRACT(^TMP(NS,$JOB,CT),70)=$JUSTIFY(SPPDU,8,2)
+8 SET CT=CT+1
+9 SET $EXTRACT(^TMP(NS,$JOB,CT),59)=$JUSTIFY(PPOU,8,2)
SET $EXTRACT(^TMP(NS,$JOB,CT),70)=$JUSTIFY(SPPOU,8,2)
+10 QUIT
+11 ;
GMAIL ; send post-install message
+1 SET XMSUB="PSS*1*208 Post-Install Drug Price Update Report"
+2 SET XMDUZ="PHARMACY DATA MANAGEMENT PACKAGE"
SET XMY(DUZ)=""
+3 IF $DATA(^XUSEC("PSNMGR"))
SET PSSDUZ=0
FOR
SET PSSDUZ=$ORDER(^XUSEC("PSNMGR",PSSDUZ))
if 'PSSDUZ
QUIT
SET XMY(PSSDUZ)=""
+4 IF $DATA(^XUSEC("PSA ORDERS"))
SET PSSDUZ=0
FOR
SET PSSDUZ=$ORDER(^XUSEC("PSA ORDERS",PSSDUZ))
if 'PSSDUZ
QUIT
SET XMY(PSSDUZ)=""
+5 IF $DATA(^XUSEC("PSAMGR"))
SET PSSDUZ=0
FOR
SET PSSDUZ=$ORDER(^XUSEC("PSDMGR",PSSDUZ))
if 'PSSDUZ
QUIT
SET XMY(PSSDUZ)=""
+6 IF CT=8
SET ^TMP(NS,$JOB,7)="No discrepancy found, nothing to update..."
+7 SET XMTEXT="^TMP(""PSS208"",$J,"
NEW DIFROM
DO ^XMD
+8 KILL XMSUB,XMDUZ,XMY,XMTEXT,PSSDUZ,^TMP(NS,$JOB)
+9 QUIT
+10 ;
