- PSSDACS ;BIR/WRT-loops thru file 50 and sends MM message if a "N" is in APPLICATION PACKAGES' USE field ; 10/22/97 15:21
- ;;1.0;PHARMACY DATA MANAGEMENT;**3**;9/30/97
- ; POST-INSTALL ROUTINE
- BEGIN K ^TMP($J,"PSSBT")
- D SETOP,START,REBD
- N DIFROM D MESS
- DONE K NBR,PSSDUZ,NM
- Q
- SETOP S ^TMP($J,"PSSBT","*1",1)="The following entries need to be reviewed as to how they are marked package-",^TMP($J,"PSSBT","*2",2)="wise as to Drug Accountability/Inventory Interface vs. Controlled Substances."
- S ^TMP($J,"PSSBT","*3",3)="If entries need to be marked or unmarked, use the ""Controlled Substances Menu"".",^TMP($J,"PSSBT","*4",4)="Select ""Supervisor (CS) Menu"", then select ""Set Up CS (Build Files) Menu""."
- S ^TMP($J,"PSSBT","*5",5)="Select ""Enter/Edit Menu"" and then select ""Mark/Unmark for Controlled SubstancesUse"" option.",^TMP($J,"PSSBT","*6",6)=" ",^TMP($J,"PSSBT","*7",7)=" "
- Q
- START S NM="" F S NM=$O(^PSDRUG("B",NM)) Q:NM="" S NBR=$O(^PSDRUG("B",NM,0)) I $P($G(^PSDRUG(NBR,2)),"^",3)["N" D SETIT
- Q
- SETIT S ^TMP($J,"PSSBT",$P(^PSDRUG(NBR,0),"^"),NBR)=$P(^PSDRUG(NBR,0),"^")
- Q
- REBD S NME="" F S NME=$O(^TMP($J,"PSSBT",NME)) Q:NME="" S NDA=$O(^TMP($J,"PSSBT",NME,0)) S NUM=$S('$D(NUM):9,1:NUM+1),^TMP($J,"PSSWRT",NUM,0)=$P(^TMP($J,"PSSBT",NME,NDA),"^")
- Q
- MESS S XMDUZ="PHARMACY DATA MANAGEMENT PACKAGE",XMSUB="DRUGS TO BE REVIEWED (DA vs CS)",XMTEXT="^TMP($J,""PSSWRT"",",XMY(DUZ)=""
- I $D(^XUSEC("PSAMGR")) F PSSDUZ=0:0 S PSSDUZ=$O(^XUSEC("PSAMGR",PSSDUZ)) Q:'PSSDUZ S XMY(PSSDUZ)=""
- I $D(^XUSEC("PSA ORDERS")) F PSSDUZ=0:0 S PSSDUZ=$O(^XUSEC("PSA ORDERS",PSSDUZ)) Q:'PSSDUZ S XMY(PSSDUZ)=""
- I $D(^XUSEC("PSDMGR")) F PSSDUZ=0:0 S PSSDUZ=$O(^XUSEC("PSDMGR",PSSDUZ)) Q:'PSSDUZ S XMY(PSSDUZ)=""
- D ^XMD K ^TMP($J,"PSSBT"),^TMP($J,"PSSWRT"),XMY,NUM,XMDUZ,XMTEXT,PSSDUZ,XMSUB
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDACS 1826 printed Apr 23, 2025@18:44:39 Page 2
- PSSDACS ;BIR/WRT-loops thru file 50 and sends MM message if a "N" is in APPLICATION PACKAGES' USE field ; 10/22/97 15:21
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**3**;9/30/97
- +2 ; POST-INSTALL ROUTINE
- BEGIN KILL ^TMP($JOB,"PSSBT")
- +1 DO SETOP
- DO START
- DO REBD
- +2 NEW DIFROM
- DO MESS
- DONE KILL NBR,PSSDUZ,NM
- +1 QUIT
- SETOP SET ^TMP($JOB,"PSSBT","*1",1)="The following entries need to be reviewed as to how they are marked package-"
- SET ^TMP($JOB,"PSSBT","*2",2)="wise as to Drug Accountability/Inventory Interface vs. Controlled Substances."
- +1 SET ^TMP($JOB,"PSSBT","*3",3)="If entries need to be marked or unmarked, use the ""Controlled Substances Menu""."
- SET ^TMP($JOB,"PSSBT","*4",4)="Select ""Supervisor (CS) Menu"", then select ""Set Up CS (Build Files) Menu""."
- +2 SET ^TMP($JOB,"PSSBT","*5",5)="Select ""Enter/Edit Menu"" and then select ""Mark/Unmark for Controlled SubstancesUse"" option."
- SET ^TMP($JOB,"PSSBT","*6",6)=" "
- SET ^TMP($JOB,"PSSBT","*7",7)=" "
- +3 QUIT
- START SET NM=""
- FOR
- SET NM=$ORDER(^PSDRUG("B",NM))
- if NM=""
- QUIT
- SET NBR=$ORDER(^PSDRUG("B",NM,0))
- IF $PIECE($GET(^PSDRUG(NBR,2)),"^",3)["N"
- DO SETIT
- +1 QUIT
- SETIT SET ^TMP($JOB,"PSSBT",$PIECE(^PSDRUG(NBR,0),"^"),NBR)=$PIECE(^PSDRUG(NBR,0),"^")
- +1 QUIT
- REBD SET NME=""
- FOR
- SET NME=$ORDER(^TMP($JOB,"PSSBT",NME))
- if NME=""
- QUIT
- SET NDA=$ORDER(^TMP($JOB,"PSSBT",NME,0))
- SET NUM=$SELECT('$DATA(NUM):9,1:NUM+1)
- SET ^TMP($JOB,"PSSWRT",NUM,0)=$PIECE(^TMP($JOB,"PSSBT",NME,NDA),"^")
- +1 QUIT
- MESS SET XMDUZ="PHARMACY DATA MANAGEMENT PACKAGE"
- SET XMSUB="DRUGS TO BE REVIEWED (DA vs CS)"
- SET XMTEXT="^TMP($J,""PSSWRT"","
- SET XMY(DUZ)=""
- +1 IF $DATA(^XUSEC("PSAMGR"))
- FOR PSSDUZ=0:0
- SET PSSDUZ=$ORDER(^XUSEC("PSAMGR",PSSDUZ))
- if 'PSSDUZ
- QUIT
- SET XMY(PSSDUZ)=""
- +2 IF $DATA(^XUSEC("PSA ORDERS"))
- FOR PSSDUZ=0:0
- SET PSSDUZ=$ORDER(^XUSEC("PSA ORDERS",PSSDUZ))
- if 'PSSDUZ
- QUIT
- SET XMY(PSSDUZ)=""
- +3 IF $DATA(^XUSEC("PSDMGR"))
- FOR PSSDUZ=0:0
- SET PSSDUZ=$ORDER(^XUSEC("PSDMGR",PSSDUZ))
- if 'PSSDUZ
- QUIT
- SET XMY(PSSDUZ)=""
- +4 DO ^XMD
- KILL ^TMP($JOB,"PSSBT"),^TMP($JOB,"PSSWRT"),XMY,NUM,XMDUZ,XMTEXT,PSSDUZ,XMSUB
- +5 QUIT
