- 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 Feb 18, 2025@23:55:25 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
