SDP498P ;ALB/TEH - PCMM Post Init for locks; 18 Apr 2003 9:36 AM ; 8/23/05 2:34pm ; Compiled May 23, 2007 07:37:17
;;5.3;Scheduling;**498**;AUG 13, 1993;Build 23
;
;IA 4988 (APPROVED)
;
;The following OPTIONS will have the locks removed.
;
;
; SCMC EXTENDED REPORT
; SCMC FLAGGED
; SCMC INACTIVATED REPORT
; SC PCMM DIRECT PC FTEE
; SCMC PRACTITIONER FLAGGED
; SCMC PC STAFF AUTO INACTIVATE
; SCMC PCMM MAIN MENU
;
;
;The following OPTIONS will have the lock SC PCMM SETUP.
;
; SCMC PCMM NIGHTLY TASK
; SCMC RETRANSMIT
; SCMC PCMM ERR CODE REPORT
; SCMC EXTEND A PATIENT
; SCMC HL7 MENU
; SCMC CLEAN GHOST ENTRIES
; SCMC CLEAN INSTITUTION
;
;The following OPTION will have the lock SCMC PCMM RETRANSMIT.
;
; SCMC PCMM TRANS ERROR PROC
; SCMC PCMM TRANS ERROR REPORT
;
;The following OPTION will be deleted from the SCMC PCMM MAIN MENU.
;
;SCMC PCMM EWL MENU
;
;The following OPTION will be added the SCMC PCMM MAIN MENU.
;
; SD WAIT LIST MENU
;
;
Q
EN ;ENTRY POINT
;REMOVE LOCKS
N SDPI,SDPX,DA,DR,DIE,DIK,SDPLOCK,SDPMESS,SDPMM,SDPEWL,SDPNEWL,DIC,X,SDPIEN
F SDPI=1:1:7 S SDPX=$P($T(RE+SDPI),";",2) D
.S DA=$O(^DIC(19,"B",SDPX,0)) I DA="" Q
.S DR="3///@",DIE="^DIC(19," D ^DIE
.S SDPMESS=" LOCK REMOVED FROM "_SDPX D MESS
;ADD LOCK SC PCMM SETUP
S SDPLOCK="SC PCMM SETUP"
F SDPI=1:1:7 S SDPX=$P($T(LOCK+SDPI),";",2) D
.S DA=$O(^DIC(19,"B",SDPX,0)) I DA="" Q
.S DR="3///^S X=SDPLOCK",DIE="^DIC(19," D ^DIE
.S SDPMESS="LOCK SC PCMM SETUP HAS BEEN APPLIED TO "_SDPX D MESS
S SDPLOCK="SCMC PCMM RETRANSMIT"
F SDPI=8,9 S SDPX=$P($T(LOCK+SDPI),";",2) D
.S DA=$O(^DIC(19,"B",SDPX,0)) I DA="" Q
.S DR="3///^S X=SDPLOCK",DIE="^DIC(19," D ^DIE
.S SDPMESS="LOCK SCMC PCMM RETRANSMIT HAS BEEN APPLIED TO "_SDPX D MESS
OPT ;GET SCMC PCMM MAIN MENU INTERNAL IEN
S SDPMM=$O(^DIC(19,"B","SCMC PCMM MAIN MENU",0)) Q:SDPMM=""
I '$D(^DIC(19,SDPMM,0)) Q
;GET BAD OPTION IEN SCMC PCMM EWL MENU
S SDPEWL=$O(^DIC(19,"B","SCMC PCMM EWL MENU",0)) Q:SDPEWL=""
I '$D(^DIC(19,SDPEWL,0)) Q
;GET GOOD OPTION IEN SD WAIT LIST MENU
S SDPNEWL=$O(^DIC(19,"B","SD WAIT LIST MENU",0)) Q:SDPNEWL=""
DEL ;DELETE BAD OPTION
S DA=$O(^DIC(19,SDPMM,10,"B",SDPEWL,0))
I 'DA S SDPMESS="The OPTION SCMC PCMM EWL MENU is not on the SCMC PCMM MAIN MENU." G DEL1
S DA(1)=SDPMM
S DIK="^DIC(19,"_SDPMM_",10," D ^DIK
S SDPMESS="The OPTION "_"SCMC PCMM EWL MENU has been removed."
DEL1 D MES^XPDUTL(SDPMESS)
ADD ;ADD EWL WAIT LIST OPTION
S SDPMM=$O(^DIC(19,"B","SCMC PCMM MAIN MENU",0)) Q:SDPMM=""
S SDPNEWL=$O(^DIC(19,"B","SD WAIT LIST MENU",0)) Q:SDPNEWL=""
I $D(^DIC(19,SDPMM,10,"B",SDPNEWL)) D G ADDER
.S SDPMESS="The OPTION "_"SD WAIT LIST MENU is already on the SCMC PCMM MAIN MENU."
.S SDPMESS(1)="*** No update for SCMC PCMM MAIN MENU will be made."
S DA(1)=SDPMM,DIC(0)="L",DA=SDPNEWL,X=SDPNEWL
S DIC="^DIC(19,"_DA(1)_",10,",DIC("P")=$P(^DD(19,10,0),U,2) K D0
D FILE^DICN
ADD0 S DA(1)=SDPMM,DR="2////^S X=""WL"""
S DR(1)="10;"
S DR(1,19)="10;"
S DR(2,"19.01")="2",DIE="^DIC(19,"_DA(1)_",10,"
D ^DIE
S SDPMESS="The OPTION "_"SD WAIT LIST MENU has been added."
ADD1 S SDPMM=$O(^DIC(19,"B","SCMC PCMM MAIN MENU",0)) Q:SDPMM=""
S SDPNEWL=$O(^DIC(19,"B","SD WAIT LIST MENU",0)) Q:SDPNEWL=""
S SDPIEN=$O(^DIC(19,SDPMM,10,"B",SDPNEWL,0))
S SDPMM=$O(^DIC(19,"B","SCMC PCMM MAIN MENU",0)) Q:SDPMM=""
S DA(1)=SDPMM,DA=SDPIEN,DR="2////^S X=""WL"""
S DR(1)="10;"
S DR(1,19)="10;"
S DR(2,"19.01")="2",DIE="^DIC(19,"_DA(1)_",10,"
D ^DIE
S SDPMESS="The NEW WAIT LIST OPTION has been place on the SCMC PCMM MAIN MENU."
ADDER D MES^XPDUTL(SDPMESS) I $D(SDPMESS(1)) D
.S SDPMESS=SDPMESS(1) D MES^XPDUTL(SDPMESS)
;REPAIR REPORTS MENU IN EWL MENU
Q
MESS D MES^XPDUTL(SDPMESS)
Q
RE ;REMOVAL LIST
;SCMC EXTENDED REPORT
;SCMC FLAGGED
;SCMC INACTIVATED REPORT
;SC PCMM DIRECT PC FTEE
;SCMC PRACTITIONER FLAGGED
;SCMC PC STAFF AUTO INACTIVATE
;SCMC PCMM MAIN MENU
;
LOCK ;LOCK LIST
;SCMC PCMM NIGHTLY TASK
;SCMC PCMM ERR CODE REPORT
;SCMC EXTEND A PATIENT
;SCMC HL7 MENU
;SCMC CLEAN GHOST ENTRIES
;SCMC CLEAN INSTITUTION
;SCMC RETRANSMIT
;SCMC PCMM TRANS ERROR REPORT
;SCMC PCMM TRANS ERROR PROC
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDP498P 4390 printed Apr 09, 2024@21:59:14 Page 2
SDP498P ;ALB/TEH - PCMM Post Init for locks; 18 Apr 2003 9:36 AM ; 8/23/05 2:34pm ; Compiled May 23, 2007 07:37:17
+1 ;;5.3;Scheduling;**498**;AUG 13, 1993;Build 23
+2 ;
+3 ;IA 4988 (APPROVED)
+4 ;
+5 ;The following OPTIONS will have the locks removed.
+6 ;
+7 ;
+8 ; SCMC EXTENDED REPORT
+9 ; SCMC FLAGGED
+10 ; SCMC INACTIVATED REPORT
+11 ; SC PCMM DIRECT PC FTEE
+12 ; SCMC PRACTITIONER FLAGGED
+13 ; SCMC PC STAFF AUTO INACTIVATE
+14 ; SCMC PCMM MAIN MENU
+15 ;
+16 ;
+17 ;The following OPTIONS will have the lock SC PCMM SETUP.
+18 ;
+19 ; SCMC PCMM NIGHTLY TASK
+20 ; SCMC RETRANSMIT
+21 ; SCMC PCMM ERR CODE REPORT
+22 ; SCMC EXTEND A PATIENT
+23 ; SCMC HL7 MENU
+24 ; SCMC CLEAN GHOST ENTRIES
+25 ; SCMC CLEAN INSTITUTION
+26 ;
+27 ;The following OPTION will have the lock SCMC PCMM RETRANSMIT.
+28 ;
+29 ; SCMC PCMM TRANS ERROR PROC
+30 ; SCMC PCMM TRANS ERROR REPORT
+31 ;
+32 ;The following OPTION will be deleted from the SCMC PCMM MAIN MENU.
+33 ;
+34 ;SCMC PCMM EWL MENU
+35 ;
+36 ;The following OPTION will be added the SCMC PCMM MAIN MENU.
+37 ;
+38 ; SD WAIT LIST MENU
+39 ;
+40 ;
+41 QUIT
EN ;ENTRY POINT
+1 ;REMOVE LOCKS
+2 NEW SDPI,SDPX,DA,DR,DIE,DIK,SDPLOCK,SDPMESS,SDPMM,SDPEWL,SDPNEWL,DIC,X,SDPIEN
+3 FOR SDPI=1:1:7
SET SDPX=$PIECE($TEXT(RE+SDPI),";",2)
Begin DoDot:1
+4 SET DA=$ORDER(^DIC(19,"B",SDPX,0))
IF DA=""
QUIT
+5 SET DR="3///@"
SET DIE="^DIC(19,"
DO ^DIE
+6 SET SDPMESS=" LOCK REMOVED FROM "_SDPX
DO MESS
End DoDot:1
+7 ;ADD LOCK SC PCMM SETUP
+8 SET SDPLOCK="SC PCMM SETUP"
+9 FOR SDPI=1:1:7
SET SDPX=$PIECE($TEXT(LOCK+SDPI),";",2)
Begin DoDot:1
+10 SET DA=$ORDER(^DIC(19,"B",SDPX,0))
IF DA=""
QUIT
+11 SET DR="3///^S X=SDPLOCK"
SET DIE="^DIC(19,"
DO ^DIE
+12 SET SDPMESS="LOCK SC PCMM SETUP HAS BEEN APPLIED TO "_SDPX
DO MESS
End DoDot:1
+13 SET SDPLOCK="SCMC PCMM RETRANSMIT"
+14 FOR SDPI=8,9
SET SDPX=$PIECE($TEXT(LOCK+SDPI),";",2)
Begin DoDot:1
+15 SET DA=$ORDER(^DIC(19,"B",SDPX,0))
IF DA=""
QUIT
+16 SET DR="3///^S X=SDPLOCK"
SET DIE="^DIC(19,"
DO ^DIE
+17 SET SDPMESS="LOCK SCMC PCMM RETRANSMIT HAS BEEN APPLIED TO "_SDPX
DO MESS
End DoDot:1
OPT ;GET SCMC PCMM MAIN MENU INTERNAL IEN
+1 SET SDPMM=$ORDER(^DIC(19,"B","SCMC PCMM MAIN MENU",0))
if SDPMM=""
QUIT
+2 IF '$DATA(^DIC(19,SDPMM,0))
QUIT
+3 ;GET BAD OPTION IEN SCMC PCMM EWL MENU
+4 SET SDPEWL=$ORDER(^DIC(19,"B","SCMC PCMM EWL MENU",0))
if SDPEWL=""
QUIT
+5 IF '$DATA(^DIC(19,SDPEWL,0))
QUIT
+6 ;GET GOOD OPTION IEN SD WAIT LIST MENU
+7 SET SDPNEWL=$ORDER(^DIC(19,"B","SD WAIT LIST MENU",0))
if SDPNEWL=""
QUIT
DEL ;DELETE BAD OPTION
+1 SET DA=$ORDER(^DIC(19,SDPMM,10,"B",SDPEWL,0))
+2 IF 'DA
SET SDPMESS="The OPTION SCMC PCMM EWL MENU is not on the SCMC PCMM MAIN MENU."
GOTO DEL1
+3 SET DA(1)=SDPMM
+4 SET DIK="^DIC(19,"_SDPMM_",10,"
DO ^DIK
+5 SET SDPMESS="The OPTION "_"SCMC PCMM EWL MENU has been removed."
DEL1 DO MES^XPDUTL(SDPMESS)
ADD ;ADD EWL WAIT LIST OPTION
+1 SET SDPMM=$ORDER(^DIC(19,"B","SCMC PCMM MAIN MENU",0))
if SDPMM=""
QUIT
+2 SET SDPNEWL=$ORDER(^DIC(19,"B","SD WAIT LIST MENU",0))
if SDPNEWL=""
QUIT
+3 IF $DATA(^DIC(19,SDPMM,10,"B",SDPNEWL))
Begin DoDot:1
+4 SET SDPMESS="The OPTION "_"SD WAIT LIST MENU is already on the SCMC PCMM MAIN MENU."
+5 SET SDPMESS(1)="*** No update for SCMC PCMM MAIN MENU will be made."
End DoDot:1
GOTO ADDER
+6 SET DA(1)=SDPMM
SET DIC(0)="L"
SET DA=SDPNEWL
SET X=SDPNEWL
+7 SET DIC="^DIC(19,"_DA(1)_",10,"
SET DIC("P")=$PIECE(^DD(19,10,0),U,2)
KILL D0
+8 DO FILE^DICN
ADD0 SET DA(1)=SDPMM
SET DR="2////^S X=""WL"""
+1 SET DR(1)="10;"
+2 SET DR(1,19)="10;"
+3 SET DR(2,"19.01")="2"
SET DIE="^DIC(19,"_DA(1)_",10,"
+4 DO ^DIE
+5 SET SDPMESS="The OPTION "_"SD WAIT LIST MENU has been added."
ADD1 SET SDPMM=$ORDER(^DIC(19,"B","SCMC PCMM MAIN MENU",0))
if SDPMM=""
QUIT
+1 SET SDPNEWL=$ORDER(^DIC(19,"B","SD WAIT LIST MENU",0))
if SDPNEWL=""
QUIT
+2 SET SDPIEN=$ORDER(^DIC(19,SDPMM,10,"B",SDPNEWL,0))
+3 SET SDPMM=$ORDER(^DIC(19,"B","SCMC PCMM MAIN MENU",0))
if SDPMM=""
QUIT
+4 SET DA(1)=SDPMM
SET DA=SDPIEN
SET DR="2////^S X=""WL"""
+5 SET DR(1)="10;"
+6 SET DR(1,19)="10;"
+7 SET DR(2,"19.01")="2"
SET DIE="^DIC(19,"_DA(1)_",10,"
+8 DO ^DIE
+9 SET SDPMESS="The NEW WAIT LIST OPTION has been place on the SCMC PCMM MAIN MENU."
ADDER DO MES^XPDUTL(SDPMESS)
IF $DATA(SDPMESS(1))
Begin DoDot:1
+1 SET SDPMESS=SDPMESS(1)
DO MES^XPDUTL(SDPMESS)
End DoDot:1
+2 ;REPAIR REPORTS MENU IN EWL MENU
+3 QUIT
MESS DO MES^XPDUTL(SDPMESS)
+1 QUIT
RE ;REMOVAL LIST
+1 ;SCMC EXTENDED REPORT
+2 ;SCMC FLAGGED
+3 ;SCMC INACTIVATED REPORT
+4 ;SC PCMM DIRECT PC FTEE
+5 ;SCMC PRACTITIONER FLAGGED
+6 ;SCMC PC STAFF AUTO INACTIVATE
+7 ;SCMC PCMM MAIN MENU
+8 ;
LOCK ;LOCK LIST
+1 ;SCMC PCMM NIGHTLY TASK
+2 ;SCMC PCMM ERR CODE REPORT
+3 ;SCMC EXTEND A PATIENT
+4 ;SCMC HL7 MENU
+5 ;SCMC CLEAN GHOST ENTRIES
+6 ;SCMC CLEAN INSTITUTION
+7 ;SCMC RETRANSMIT
+8 ;SCMC PCMM TRANS ERROR REPORT
+9 ;SCMC PCMM TRANS ERROR PROC
