SCMCOPT ;ALB/DJS/ART - MARK SET OF PCMM OPTIONS OUT-OF-ORDER ;02/27/2015
;;5.3;Scheduling;**603**;AUG 13, 1993;Build 79
;
QUIT
;
;Supported ICRs
; #1157 - XPDMENU call
; #5567 - XPDPROT call
; #2053 - Data Base Server API: Editing Utilities (DIE)
; #2056 - Data Base Server API: Data Retriever Utilities (DIQ)
; #10060 - NEW PERSON FILE
; #10075 - OPTION FILE
; #10141 - XPDUTL - Public APIs for KIDS
;
OPTOUT ;Set option out-of-order
;
; OPT - Menu option to mark out-of-order
; TXT - Out-of-order message text
;
N I,OPT,TXT
S TXT="This functionality is now accomplished by the PCMM Web Application."
;
;Set up FOR loop to process each OOO option
;
F I=1:1 S OPT=$P($TEXT(OPTLIST+I),";;",2) Q:OPT="$$END"!(OPT="") D
. D OUT^XPDMENU(OPT,TXT) ;Mark option out-of-order
DO MES^XPDUTL(" o Legacy PCMM menu options were marked Out-of-Order.")
DO MES^XPDUTL(" ")
;
PROTDIS ;Disable protocol
;
; PROT - Protocol to disable
; TXT - Disabled protocol message text
;
N I,PROT,TXT
S TXT="This functionality is now accomplished by the PCMM Web Application."
;
;Set up FOR loop to process each disabled protocol
;
F I=1:1 S PROT=$P($TEXT(PROTLIST+I),";;",2) Q:PROT="$$END"!(PROT="") D
. D OUT^XPDPROT(PROT,TXT) ;Disable protocol
DO MES^XPDUTL(" o Legacy PCMM - SC PC PATIENT ASSIGN/UNASSIGN - protocol was disabled.")
DO MES^XPDUTL(" ")
QUIT
;
RESTORE ;UnSet option out-of-order
;
; OPT - Menu option to mark out-of-order
; TXT - Out-of-order message text
;
N I,OPT,TXT
S TXT=""
;
;Set up FOR loop to process each OOO option
;
F I=1:1 S OPT=$P($TEXT(OPTLIST+I),";;",2) Q:OPT="$$END"!(OPT="") D
. D OUT^XPDMENU(OPT,TXT) ;UnMark option out-of-order
W !!,"Legacy PCMM options were unmarked Out-of-Order.",!
;
QUIT
;
;
NEW SCGUIIEN,SCWEBIEN,SCDUZ,SCSECIEN,SCIENS,SCFDA,SCERR
NEW SCGUINM,SCWEBNM
SET SCGUINM="SCMC PCMM GUI WORKSTATION"
SET SCWEBNM="SCMC PCMMR WEB USER MENU"
;
SET SCGUIIEN=$$FIND1^DIC(19,"","BX",SCGUINM,"","","")
SET SCWEBIEN=$$FIND1^DIC(19,"","BX",SCWEBNM,"","","")
QUIT:'SCGUIIEN
QUIT:'SCWEBIEN
;
WRITE !,"This routine will convert a user's Seconary Menu Option from",!
WRITE "SCMC PCMM GUI WORKSTATION to SCMC PCMMR WEB USER MENU",!
;
SET ^XTMP("SCMC-SECMENU",0)=$$FMADD^XLFDT($$DT^XLFDT(),180)_U_$$DT^XLFDT()_U_"Convert PCMM Users Secondary Menu Option"
SET SCDUZ=0
FOR SET SCDUZ=$ORDER(^VA(200,SCDUZ)) QUIT:'+SCDUZ DO
. SET SCSECIEN=0
. FOR SET SCSECIEN=$ORDER(^VA(200,SCDUZ,203,SCSECIEN)) QUIT:'+SCSECIEN DO
. . SET SCIENS=SCSECIEN_","_SCDUZ_","
. . IF $$GET1^DIQ(200.03,SCIENS,.01,"I")=SCGUIIEN DO ;if = SCMC PCMM GUI WORKSTATION
. . . ;change it to SCMC PCMMR WEB USER MENU
. . . NEW SCFDA
. . . SET SCFDA(200.03,SCIENS,.01)=SCWEBIEN
. . . SET SCFDA(200.03,SCIENS,2)=""
. . . DO FILE^DIE("K","SCFDA","SCERR")
. . . SET ^XTMP("SCMC-SECMENU",SCDUZ)=$$GET1^DIQ(200,SCDUZ,.01)
;
;list
WRITE !!,"Users with Secondary Menu Option - SCMC PCMMR WEB USER MENU",!
SET SCDUZ=0
FOR SET SCDUZ=$ORDER(^VA(200,SCDUZ)) QUIT:'+SCDUZ DO
. SET SCSECIEN=0
. FOR SET SCSECIEN=$ORDER(^VA(200,SCDUZ,203,SCSECIEN)) QUIT:'+SCSECIEN DO
. . SET SCIENS=SCSECIEN_","_SCDUZ_","
. . IF $$GET1^DIQ(200.03,SCIENS,.01,"I")=SCWEBIEN DO ;if = SCMC PCMMR WEB USER MENU
. . . WRITE "DUZ: ",SCDUZ," NAME: ",$$GET1^DIQ(200,SCDUZ,.01),!
;
QUIT
;
;
NEW SCGUIIEN,SCWEBIEN,SCDUZ,SCSECIEN,SCIENS,SCFDA,SCERR
NEW SCGUINM,SCWEBNM
SET SCGUINM="SCMC PCMM GUI WORKSTATION"
SET SCWEBNM="SCMC PCMMR WEB USER MENU"
;
SET SCGUIIEN=$$FIND1^DIC(19,"","BX",SCGUINM,"","","")
SET SCWEBIEN=$$FIND1^DIC(19,"","BX",SCWEBNM,"","","")
QUIT:'SCGUIIEN
QUIT:'SCWEBIEN
;
;list
WRITE !,"This routine will convert a user's Seconary Menu Option from",!
WRITE "SCMC PCMMR WEB USER MENU to SCMC PCMM GUI WORKSTATION",!
WRITE !,"Users with Secondary Menu Option - SCMC PCMMR WEB USER MENU",!
SET SCDUZ=0
FOR SET SCDUZ=$ORDER(^VA(200,SCDUZ)) QUIT:'+SCDUZ DO
. SET SCSECIEN=0
. FOR SET SCSECIEN=$ORDER(^VA(200,SCDUZ,203,SCSECIEN)) QUIT:'+SCSECIEN DO
. . SET SCIENS=SCSECIEN_","_SCDUZ_","
. . IF $$GET1^DIQ(200.03,SCIENS,.01,"I")=SCWEBIEN DO ;if = SCMC PCMMR WEB USER MENU
. . . WRITE "DUZ: ",SCDUZ," NAME: ",$$GET1^DIQ(200,SCDUZ,.01),!
;
NEW DIR,X,Y,DIRUT
SET DIR(0)="Y"
SET DIR("A")="Do you want to convert now"
SET DIR("B")="NO"
DO ^DIR
QUIT:$DATA(DIRUT)
QUIT:'Y
;
;convert
SET ^XTMP("SCMC-SECMENU2",0)=$$FMADD^XLFDT($$DT^XLFDT(),180)_U_$$DT^XLFDT()_U_"UnConvert PCMM Users Secondary Menu Option"
SET SCDUZ=0
FOR SET SCDUZ=$ORDER(^VA(200,SCDUZ)) QUIT:'+SCDUZ DO
. SET SCSECIEN=0
. FOR SET SCSECIEN=$ORDER(^VA(200,SCDUZ,203,SCSECIEN)) QUIT:'+SCSECIEN DO
. . SET SCIENS=SCSECIEN_","_SCDUZ_","
. . IF $$GET1^DIQ(200.03,SCIENS,.01,"I")=SCWEBIEN DO ;if = SCMC PCMMR WEB USER MENU
. . . ;change it to SCMC PCMMR WEB USER MENU
. . . NEW SCFDA
. . . SET SCFDA(200.03,SCIENS,.01)=SCGUIIEN
. . . SET SCFDA(200.03,SCIENS,2)=""
. . . DO FILE^DIE("K","SCFDA","SCERR")
. . . SET ^XTMP("SCMC-SECMENU2",SCDUZ)=$$GET1^DIQ(200,SCDUZ,.01)
;
;list again
WRITE !!,"Users with Secondary Menu Option - SCMC PCMM GUI WORKSTATION",!
SET SCDUZ=0
FOR SET SCDUZ=$ORDER(^VA(200,SCDUZ)) QUIT:'+SCDUZ DO
. SET SCSECIEN=0
. FOR SET SCSECIEN=$ORDER(^VA(200,SCDUZ,203,SCSECIEN)) QUIT:'+SCSECIEN DO
. . SET SCIENS=SCSECIEN_","_SCDUZ_","
. . IF $$GET1^DIQ(200.03,SCIENS,.01,"I")=SCGUIIEN DO ;if = SCMC PCMM GUI WORKSTATION
. . . WRITE "DUZ: ",SCDUZ," NAME: ",$$GET1^DIQ(200,SCDUZ,.01),!
;
QUIT
;
OPTLIST ;OPTIONS LIST
;;SCMC PATIENT ASSIGN/UNASSIGN
;;SCMC CLEAN GHOST ENTRIES
;;SCMC CLEAN INSTITUTION
;;SCMC CONVERSION TOOLS MENU
;;SCMC EXTEND A PATIENT
;;SCMC FLAGGED
;;SCMC MU MASS TEAM UNASSIGNMENT
;;SCMC PC ATTENDING CONVERSION
;;SCMC PCMM BASELINE SEEDING
;;SCMC PCMM EDIT PRACTIT #404.52
;;SCMC PCMM NIGHTLY TASK
;;SCMC PRECEPTOR CONVERSION
;;SCMC PRECEPTOR MIGRATION RPT
;;SCMC RETRANSMIT
;;SCMC PCMM GUI WORKSTATION
;;SCMC PC ATTENDING ASGN RPT
;;$$END
;
PROTLIST ;PROTOCOLS LIST
;;SC PC PATIENT ASSIGN/UNASSIGN
;;$$END
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCOPT 6446 printed Dec 13, 2024@02:41:05 Page 2
SCMCOPT ;ALB/DJS/ART - MARK SET OF PCMM OPTIONS OUT-OF-ORDER ;02/27/2015
+1 ;;5.3;Scheduling;**603**;AUG 13, 1993;Build 79
+2 ;
+3 QUIT
+4 ;
+5 ;Supported ICRs
+6 ; #1157 - XPDMENU call
+7 ; #5567 - XPDPROT call
+8 ; #2053 - Data Base Server API: Editing Utilities (DIE)
+9 ; #2056 - Data Base Server API: Data Retriever Utilities (DIQ)
+10 ; #10060 - NEW PERSON FILE
+11 ; #10075 - OPTION FILE
+12 ; #10141 - XPDUTL - Public APIs for KIDS
+13 ;
OPTOUT ;Set option out-of-order
+1 ;
+2 ; OPT - Menu option to mark out-of-order
+3 ; TXT - Out-of-order message text
+4 ;
+5 NEW I,OPT,TXT
+6 SET TXT="This functionality is now accomplished by the PCMM Web Application."
+7 ;
+8 ;Set up FOR loop to process each OOO option
+9 ;
+10 FOR I=1:1
SET OPT=$PIECE($TEXT(OPTLIST+I),";;",2)
if OPT="$$END"!(OPT="")
QUIT
Begin DoDot:1
+11 ;Mark option out-of-order
DO OUT^XPDMENU(OPT,TXT)
End DoDot:1
+12 DO MES^XPDUTL(" o Legacy PCMM menu options were marked Out-of-Order.")
+13 DO MES^XPDUTL(" ")
+14 ;
PROTDIS ;Disable protocol
+1 ;
+2 ; PROT - Protocol to disable
+3 ; TXT - Disabled protocol message text
+4 ;
+5 NEW I,PROT,TXT
+6 SET TXT="This functionality is now accomplished by the PCMM Web Application."
+7 ;
+8 ;Set up FOR loop to process each disabled protocol
+9 ;
+10 FOR I=1:1
SET PROT=$PIECE($TEXT(PROTLIST+I),";;",2)
if PROT="$$END"!(PROT="")
QUIT
Begin DoDot:1
+11 ;Disable protocol
DO OUT^XPDPROT(PROT,TXT)
End DoDot:1
+12 DO MES^XPDUTL(" o Legacy PCMM - SC PC PATIENT ASSIGN/UNASSIGN - protocol was disabled.")
+13 DO MES^XPDUTL(" ")
+14 QUIT
+15 ;
RESTORE ;UnSet option out-of-order
+1 ;
+2 ; OPT - Menu option to mark out-of-order
+3 ; TXT - Out-of-order message text
+4 ;
+5 NEW I,OPT,TXT
+6 SET TXT=""
+7 ;
+8 ;Set up FOR loop to process each OOO option
+9 ;
+10 FOR I=1:1
SET OPT=$PIECE($TEXT(OPTLIST+I),";;",2)
if OPT="$$END"!(OPT="")
QUIT
Begin DoDot:1
+11 ;UnMark option out-of-order
DO OUT^XPDMENU(OPT,TXT)
End DoDot:1
+12 WRITE !!,"Legacy PCMM options were unmarked Out-of-Order.",!
+13 ;
+14 QUIT
+15 ;
+1 ;
+2 NEW SCGUIIEN,SCWEBIEN,SCDUZ,SCSECIEN,SCIENS,SCFDA,SCERR
+3 NEW SCGUINM,SCWEBNM
+4 SET SCGUINM="SCMC PCMM GUI WORKSTATION"
+5 SET SCWEBNM="SCMC PCMMR WEB USER MENU"
+6 ;
+7 SET SCGUIIEN=$$FIND1^DIC(19,"","BX",SCGUINM,"","","")
+8 SET SCWEBIEN=$$FIND1^DIC(19,"","BX",SCWEBNM,"","","")
+9 if 'SCGUIIEN
QUIT
+10 if 'SCWEBIEN
QUIT
+11 ;
+12 WRITE !,"This routine will convert a user's Seconary Menu Option from",!
+13 WRITE "SCMC PCMM GUI WORKSTATION to SCMC PCMMR WEB USER MENU",!
+14 ;
+15 SET ^XTMP("SCMC-SECMENU",0)=$$FMADD^XLFDT($$DT^XLFDT(),180)_U_$$DT^XLFDT()_U_"Convert PCMM Users Secondary Menu Option"
+16 SET SCDUZ=0
+17 FOR
SET SCDUZ=$ORDER(^VA(200,SCDUZ))
if '+SCDUZ
QUIT
Begin DoDot:1
+18 SET SCSECIEN=0
+19 FOR
SET SCSECIEN=$ORDER(^VA(200,SCDUZ,203,SCSECIEN))
if '+SCSECIEN
QUIT
Begin DoDot:2
+20 SET SCIENS=SCSECIEN_","_SCDUZ_","
+21 ;if = SCMC PCMM GUI WORKSTATION
IF $$GET1^DIQ(200.03,SCIENS,.01,"I")=SCGUIIEN
Begin DoDot:3
+22 ;change it to SCMC PCMMR WEB USER MENU
+23 NEW SCFDA
+24 SET SCFDA(200.03,SCIENS,.01)=SCWEBIEN
+25 SET SCFDA(200.03,SCIENS,2)=""
+26 DO FILE^DIE("K","SCFDA","SCERR")
+27 SET ^XTMP("SCMC-SECMENU",SCDUZ)=$$GET1^DIQ(200,SCDUZ,.01)
End DoDot:3
End DoDot:2
End DoDot:1
+28 ;
+29 ;list
+30 WRITE !!,"Users with Secondary Menu Option - SCMC PCMMR WEB USER MENU",!
+31 SET SCDUZ=0
+32 FOR
SET SCDUZ=$ORDER(^VA(200,SCDUZ))
if '+SCDUZ
QUIT
Begin DoDot:1
+33 SET SCSECIEN=0
+34 FOR
SET SCSECIEN=$ORDER(^VA(200,SCDUZ,203,SCSECIEN))
if '+SCSECIEN
QUIT
Begin DoDot:2
+35 SET SCIENS=SCSECIEN_","_SCDUZ_","
+36 ;if = SCMC PCMMR WEB USER MENU
IF $$GET1^DIQ(200.03,SCIENS,.01,"I")=SCWEBIEN
Begin DoDot:3
+37 WRITE "DUZ: ",SCDUZ," NAME: ",$$GET1^DIQ(200,SCDUZ,.01),!
End DoDot:3
End DoDot:2
End DoDot:1
+38 ;
+39 QUIT
+40 ;
+1 ;
+2 NEW SCGUIIEN,SCWEBIEN,SCDUZ,SCSECIEN,SCIENS,SCFDA,SCERR
+3 NEW SCGUINM,SCWEBNM
+4 SET SCGUINM="SCMC PCMM GUI WORKSTATION"
+5 SET SCWEBNM="SCMC PCMMR WEB USER MENU"
+6 ;
+7 SET SCGUIIEN=$$FIND1^DIC(19,"","BX",SCGUINM,"","","")
+8 SET SCWEBIEN=$$FIND1^DIC(19,"","BX",SCWEBNM,"","","")
+9 if 'SCGUIIEN
QUIT
+10 if 'SCWEBIEN
QUIT
+11 ;
+12 ;list
+13 WRITE !,"This routine will convert a user's Seconary Menu Option from",!
+14 WRITE "SCMC PCMMR WEB USER MENU to SCMC PCMM GUI WORKSTATION",!
+15 WRITE !,"Users with Secondary Menu Option - SCMC PCMMR WEB USER MENU",!
+16 SET SCDUZ=0
+17 FOR
SET SCDUZ=$ORDER(^VA(200,SCDUZ))
if '+SCDUZ
QUIT
Begin DoDot:1
+18 SET SCSECIEN=0
+19 FOR
SET SCSECIEN=$ORDER(^VA(200,SCDUZ,203,SCSECIEN))
if '+SCSECIEN
QUIT
Begin DoDot:2
+20 SET SCIENS=SCSECIEN_","_SCDUZ_","
+21 ;if = SCMC PCMMR WEB USER MENU
IF $$GET1^DIQ(200.03,SCIENS,.01,"I")=SCWEBIEN
Begin DoDot:3
+22 WRITE "DUZ: ",SCDUZ," NAME: ",$$GET1^DIQ(200,SCDUZ,.01),!
End DoDot:3
End DoDot:2
End DoDot:1
+23 ;
+24 NEW DIR,X,Y,DIRUT
+25 SET DIR(0)="Y"
+26 SET DIR("A")="Do you want to convert now"
+27 SET DIR("B")="NO"
+28 DO ^DIR
+29 if $DATA(DIRUT)
QUIT
+30 if 'Y
QUIT
+31 ;
+32 ;convert
+33 SET ^XTMP("SCMC-SECMENU2",0)=$$FMADD^XLFDT($$DT^XLFDT(),180)_U_$$DT^XLFDT()_U_"UnConvert PCMM Users Secondary Menu Option"
+34 SET SCDUZ=0
+35 FOR
SET SCDUZ=$ORDER(^VA(200,SCDUZ))
if '+SCDUZ
QUIT
Begin DoDot:1
+36 SET SCSECIEN=0
+37 FOR
SET SCSECIEN=$ORDER(^VA(200,SCDUZ,203,SCSECIEN))
if '+SCSECIEN
QUIT
Begin DoDot:2
+38 SET SCIENS=SCSECIEN_","_SCDUZ_","
+39 ;if = SCMC PCMMR WEB USER MENU
IF $$GET1^DIQ(200.03,SCIENS,.01,"I")=SCWEBIEN
Begin DoDot:3
+40 ;change it to SCMC PCMMR WEB USER MENU
+41 NEW SCFDA
+42 SET SCFDA(200.03,SCIENS,.01)=SCGUIIEN
+43 SET SCFDA(200.03,SCIENS,2)=""
+44 DO FILE^DIE("K","SCFDA","SCERR")
+45 SET ^XTMP("SCMC-SECMENU2",SCDUZ)=$$GET1^DIQ(200,SCDUZ,.01)
End DoDot:3
End DoDot:2
End DoDot:1
+46 ;
+47 ;list again
+48 WRITE !!,"Users with Secondary Menu Option - SCMC PCMM GUI WORKSTATION",!
+49 SET SCDUZ=0
+50 FOR
SET SCDUZ=$ORDER(^VA(200,SCDUZ))
if '+SCDUZ
QUIT
Begin DoDot:1
+51 SET SCSECIEN=0
+52 FOR
SET SCSECIEN=$ORDER(^VA(200,SCDUZ,203,SCSECIEN))
if '+SCSECIEN
QUIT
Begin DoDot:2
+53 SET SCIENS=SCSECIEN_","_SCDUZ_","
+54 ;if = SCMC PCMM GUI WORKSTATION
IF $$GET1^DIQ(200.03,SCIENS,.01,"I")=SCGUIIEN
Begin DoDot:3
+55 WRITE "DUZ: ",SCDUZ," NAME: ",$$GET1^DIQ(200,SCDUZ,.01),!
End DoDot:3
End DoDot:2
End DoDot:1
+56 ;
+57 QUIT
+58 ;
OPTLIST ;OPTIONS LIST
+1 ;;SCMC PATIENT ASSIGN/UNASSIGN
+2 ;;SCMC CLEAN GHOST ENTRIES
+3 ;;SCMC CLEAN INSTITUTION
+4 ;;SCMC CONVERSION TOOLS MENU
+5 ;;SCMC EXTEND A PATIENT
+6 ;;SCMC FLAGGED
+7 ;;SCMC MU MASS TEAM UNASSIGNMENT
+8 ;;SCMC PC ATTENDING CONVERSION
+9 ;;SCMC PCMM BASELINE SEEDING
+10 ;;SCMC PCMM EDIT PRACTIT #404.52
+11 ;;SCMC PCMM NIGHTLY TASK
+12 ;;SCMC PRECEPTOR CONVERSION
+13 ;;SCMC PRECEPTOR MIGRATION RPT
+14 ;;SCMC RETRANSMIT
+15 ;;SCMC PCMM GUI WORKSTATION
+16 ;;SCMC PC ATTENDING ASGN RPT
+17 ;;$$END
+18 ;
PROTLIST ;PROTOCOLS LIST
+1 ;;SC PC PATIENT ASSIGN/UNASSIGN
+2 ;;$$END
+3 ;
