- 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,1015**;AUG 13, 1993;Build 21
- ;
- ;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
- 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,1015**;AUG 13, 1993;Build 21
- +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
