PSS1P191 ;ALB/DRP POST INSTALL TO UPDATE ORDERABLE ITEM FILE ;06/18/15
;;1.0;PHARMACY DATA MANAGEMENT;**191**;9/30/97;Build 40
;
INIT ; Initialize Variables
N PSSOIEN,PSSDRG,PSSDRGP,PSSDSG,PSSSPCE,PSSDUZ,PSSLN,PSSDDRG,PSSINACT,PSSINACTP,PSSDDIEN,PSSDSGF
N XMDUZ,XMSUB,XMTEXT,XMY,X
S PSSDUZ=DUZ
K ^TMP($J,"PSS191"),^XTMP("PSS191")
D MAIN,QUE^PSSP191A
Q
;
MAIN ;
D UPD50P7,MAKERPT,SENDRPT
Q
;
UPD50P7 ;
S PSSDRG=""
F S PSSDRG=$O(^PS(50.7,"ADF",PSSDRG)) Q:PSSDRG="" D
.S PSSDSG=""
. F S PSSDSG=$O(^PS(50.7,"ADF",PSSDRG,PSSDSG)) Q:PSSDSG="" D
.. S PSSOIEN=""
.. F S PSSOIEN=$O(^PS(50.7,"ADF",PSSDRG,PSSDSG,PSSOIEN)) Q:PSSOIEN="" D
... I $G(^PS(50.606,PSSDSG,0))["PATCH",'+$G(^PS(50.7,PSSOIEN,4)) D
.... S PSSDSGF=^PS(50.606,PSSDSG,0)
.... S DIE="^PS(50.7,",DR="12////1",DA=PSSOIEN D ^DIE K DA,DR,DIE
.... S PSSDDIEN=""
.... F S PSSDDIEN=$O(^PS(50.7,"A50",PSSOIEN,PSSDDIEN)) Q:PSSDDIEN="" D
..... S:$G(PSSDDIEN)]"" PSSDDRG=$P(^PSDRUG(PSSDDIEN,0),"^"),PSSINACT=$G(^PSDRUG(PSSDDIEN,"I"),"NONE")
..... S ^XTMP("PSS191",$J,PSSDRG_" - "_PSSDSGF,PSSINACT,PSSDDRG,PSSDDIEN)=""
.....Q
....Q
...Q
..Q
.Q
Q
;
MAKERPT ;
S ^TMP($J,"PSS191")=""
S ^TMP($J,"PSS191",0)=" "
S ^TMP($J,"PSS191",1)=" "
S ^TMP($J,"PSS191",2)=" The following Orderable Items have the Dosage Form Patch and "
S ^TMP($J,"PSS191",3)=" the Prompt for Removal in BCMA field was updated to a value"
S ^TMP($J,"PSS191",4)=" of 1 by Patch PSS*1*191"
S ^TMP($J,"PSS191",5)=" "
S ^TMP($J,"PSS191",6)="ORDERABLE ITEM INACTIVE DISPENSE DRUG "
S ^TMP($J,"PSS191",7)="NAME - DOSAGE FORM DATE NAME IEN "
S ^TMP($J,"PSS191",8)="------------------------------ ------------ ------------------------- ------"
S ^TMP($J,"PSS191",9)=" "
S ^TMP($J,"PSS191",10)=" "
I $O(^XTMP("PSS191",$J,""))="" S ^TMP($J,"PSS191",11)="NO DRUGS TO LIST" Q
S PSSLN=11,$P(PSSSPCE," ",30)=""
S PSSDRG=""
F S PSSDRG=$O(^XTMP("PSS191",$J,PSSDRG)) Q:PSSDRG="" D
. S PSSINACT="",PSSDRGP=PSSDRG
. F S PSSINACT=$O(^XTMP("PSS191",$J,PSSDRG,PSSINACT)) Q:PSSINACT="" D
.. S PSSDDRG="",PSSINACTP=PSSINACT
.. F S PSSDDRG=$O(^XTMP("PSS191",$J,PSSDRG,PSSINACT,PSSDDRG)) Q:PSSDDRG="" D
... S PSSDDIEN=""
... F S PSSDDIEN=$O(^XTMP("PSS191",$J,PSSDRG,PSSINACT,PSSDDRG,PSSDDIEN)) Q:PSSDDIEN="" D
.... S ^TMP($J,"PSS191",PSSLN)=$E(PSSDRGP_PSSSPCE,1,30)_" "_$E($$FMTE^XLFDT(PSSINACTP,5)_PSSSPCE,1,12)_" "_$E(PSSDDRG_PSSSPCE,1,25)_" "_$E(PSSDDIEN_PSSSPCE,1,6)
.... S (PSSDRGP,PSSINACTP)=" "
.... S PSSLN=PSSLN+1
....Q
...Q
..Q
.Q
Q
SENDRPT ;Send report to user
N DIFROM ; Prevent pre-mature termination of mailman
S X="" F S X=$O(^XUSEC("PSJI MGR",X)) Q:'X S XMY(X)=""
S X="" F S X=$O(^XUSEC("PSJU MGR",X)) Q:'X S XMY(X)=""
S XMSUB="PHARMACY ORDERABLE ITEM MANAGEMENT",XMTEXT="^TMP("_$J_","_"""PSS191"""_",",XMDUZ=.5,XMY(PSSDUZ)=""
D ^XMD
K ^TMP($J,"PSS191"),^XTMP("PSS191")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS1P191 3026 printed Apr 09, 2024@21:34:16 Page 2
PSS1P191 ;ALB/DRP POST INSTALL TO UPDATE ORDERABLE ITEM FILE ;06/18/15
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**191**;9/30/97;Build 40
+2 ;
INIT ; Initialize Variables
+1 NEW PSSOIEN,PSSDRG,PSSDRGP,PSSDSG,PSSSPCE,PSSDUZ,PSSLN,PSSDDRG,PSSINACT,PSSINACTP,PSSDDIEN,PSSDSGF
+2 NEW XMDUZ,XMSUB,XMTEXT,XMY,X
+3 SET PSSDUZ=DUZ
+4 KILL ^TMP($JOB,"PSS191"),^XTMP("PSS191")
+5 DO MAIN
DO QUE^PSSP191A
+6 QUIT
+7 ;
MAIN ;
+1 DO UPD50P7
DO MAKERPT
DO SENDRPT
+2 QUIT
+3 ;
UPD50P7 ;
+1 SET PSSDRG=""
+2 FOR
SET PSSDRG=$ORDER(^PS(50.7,"ADF",PSSDRG))
if PSSDRG=""
QUIT
Begin DoDot:1
+3 SET PSSDSG=""
+4 FOR
SET PSSDSG=$ORDER(^PS(50.7,"ADF",PSSDRG,PSSDSG))
if PSSDSG=""
QUIT
Begin DoDot:2
+5 SET PSSOIEN=""
+6 FOR
SET PSSOIEN=$ORDER(^PS(50.7,"ADF",PSSDRG,PSSDSG,PSSOIEN))
if PSSOIEN=""
QUIT
Begin DoDot:3
+7 IF $GET(^PS(50.606,PSSDSG,0))["PATCH"
IF '+$GET(^PS(50.7,PSSOIEN,4))
Begin DoDot:4
+8 SET PSSDSGF=^PS(50.606,PSSDSG,0)
+9 SET DIE="^PS(50.7,"
SET DR="12////1"
SET DA=PSSOIEN
DO ^DIE
KILL DA,DR,DIE
+10 SET PSSDDIEN=""
+11 FOR
SET PSSDDIEN=$ORDER(^PS(50.7,"A50",PSSOIEN,PSSDDIEN))
if PSSDDIEN=""
QUIT
Begin DoDot:5
+12 if $GET(PSSDDIEN)]""
SET PSSDDRG=$PIECE(^PSDRUG(PSSDDIEN,0),"^")
SET PSSINACT=$GET(^PSDRUG(PSSDDIEN,"I"),"NONE")
+13 SET ^XTMP("PSS191",$JOB,PSSDRG_" - "_PSSDSGF,PSSINACT,PSSDDRG,PSSDDIEN)=""
+14 QUIT
End DoDot:5
+15 QUIT
End DoDot:4
+16 QUIT
End DoDot:3
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
+19 QUIT
+20 ;
MAKERPT ;
+1 SET ^TMP($JOB,"PSS191")=""
+2 SET ^TMP($JOB,"PSS191",0)=" "
+3 SET ^TMP($JOB,"PSS191",1)=" "
+4 SET ^TMP($JOB,"PSS191",2)=" The following Orderable Items have the Dosage Form Patch and "
+5 SET ^TMP($JOB,"PSS191",3)=" the Prompt for Removal in BCMA field was updated to a value"
+6 SET ^TMP($JOB,"PSS191",4)=" of 1 by Patch PSS*1*191"
+7 SET ^TMP($JOB,"PSS191",5)=" "
+8 SET ^TMP($JOB,"PSS191",6)="ORDERABLE ITEM INACTIVE DISPENSE DRUG "
+9 SET ^TMP($JOB,"PSS191",7)="NAME - DOSAGE FORM DATE NAME IEN "
+10 SET ^TMP($JOB,"PSS191",8)="------------------------------ ------------ ------------------------- ------"
+11 SET ^TMP($JOB,"PSS191",9)=" "
+12 SET ^TMP($JOB,"PSS191",10)=" "
+13 IF $ORDER(^XTMP("PSS191",$JOB,""))=""
SET ^TMP($JOB,"PSS191",11)="NO DRUGS TO LIST"
QUIT
+14 SET PSSLN=11
SET $PIECE(PSSSPCE," ",30)=""
+15 SET PSSDRG=""
+16 FOR
SET PSSDRG=$ORDER(^XTMP("PSS191",$JOB,PSSDRG))
if PSSDRG=""
QUIT
Begin DoDot:1
+17 SET PSSINACT=""
SET PSSDRGP=PSSDRG
+18 FOR
SET PSSINACT=$ORDER(^XTMP("PSS191",$JOB,PSSDRG,PSSINACT))
if PSSINACT=""
QUIT
Begin DoDot:2
+19 SET PSSDDRG=""
SET PSSINACTP=PSSINACT
+20 FOR
SET PSSDDRG=$ORDER(^XTMP("PSS191",$JOB,PSSDRG,PSSINACT,PSSDDRG))
if PSSDDRG=""
QUIT
Begin DoDot:3
+21 SET PSSDDIEN=""
+22 FOR
SET PSSDDIEN=$ORDER(^XTMP("PSS191",$JOB,PSSDRG,PSSINACT,PSSDDRG,PSSDDIEN))
if PSSDDIEN=""
QUIT
Begin DoDot:4
+23 SET ^TMP($JOB,"PSS191",PSSLN)=$EXTRACT(PSSDRGP_PSSSPCE,1,30)_" "_$EXTRACT($$FMTE^XLFDT(PSSINACTP,5)_PSSSPCE,1,12)_" "_$EXTRACT(PSSDDRG_PSSSPCE,1,25)_" "_$EXTRACT(PSSDDIEN_PSSSPCE,1,6)
+24 SET (PSSDRGP,PSSINACTP)=" "
+25 SET PSSLN=PSSLN+1
+26 QUIT
End DoDot:4
+27 QUIT
End DoDot:3
+28 QUIT
End DoDot:2
+29 QUIT
End DoDot:1
+30 QUIT
SENDRPT ;Send report to user
+1 ; Prevent pre-mature termination of mailman
NEW DIFROM
+2 SET X=""
FOR
SET X=$ORDER(^XUSEC("PSJI MGR",X))
if 'X
QUIT
SET XMY(X)=""
+3 SET X=""
FOR
SET X=$ORDER(^XUSEC("PSJU MGR",X))
if 'X
QUIT
SET XMY(X)=""
+4 SET XMSUB="PHARMACY ORDERABLE ITEM MANAGEMENT"
SET XMTEXT="^TMP("_$JOB_","_"""PSS191"""_","
SET XMDUZ=.5
SET XMY(PSSDUZ)=""
+5 DO ^XMD
+6 KILL ^TMP($JOB,"PSS191"),^XTMP("PSS191")
+7 QUIT
