Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCMCOPT

SCMCOPT.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  QUIT
  1.  ;
  1.  ;Supported ICRs
  1.  ; #1157 - XPDMENU call
  1.  ; #5567 - XPDPROT call
  1.  ; #2053 - Data Base Server API: Editing Utilities (DIE)
  1.  ; #2056 - Data Base Server API: Data Retriever Utilities (DIQ)
  1.  ; #10060 - NEW PERSON FILE
  1.  ; #10075 - OPTION FILE
  1.  ; #10141 - XPDUTL - Public APIs for KIDS
  1.  ;
  1. OPTOUT ;Set option out-of-order
  1.  ;
  1.  ;  OPT - Menu option to mark out-of-order
  1.  ;  TXT - Out-of-order message text
  1.  ;
  1.  N I,OPT,TXT
  1.  S TXT="This functionality is now accomplished by the PCMM Web Application."
  1.  ;
  1.  ;Set up FOR loop to process each OOO option
  1.  ;
  1.  F I=1:1 S OPT=$P($TEXT(OPTLIST+I),";;",2) Q:OPT="$$END"!(OPT="")   D
  1.  . D OUT^XPDMENU(OPT,TXT)  ;Mark option out-of-order
  1.  DO MES^XPDUTL(" o  Legacy PCMM menu options were marked Out-of-Order.")
  1.  DO MES^XPDUTL(" ")
  1.  ;
  1. PROTDIS ;Disable protocol
  1.  ;
  1.  ;  PROT - Protocol to disable
  1.  ;  TXT - Disabled protocol message text
  1.  ;
  1.  N I,PROT,TXT
  1.  S TXT="This functionality is now accomplished by the PCMM Web Application."
  1.  ;
  1.  ;Set up FOR loop to process each disabled protocol
  1.  ;
  1.  F I=1:1 S PROT=$P($TEXT(PROTLIST+I),";;",2) Q:PROT="$$END"!(PROT="")   D
  1.  . D OUT^XPDPROT(PROT,TXT)  ;Disable protocol
  1.  DO MES^XPDUTL(" o  Legacy PCMM - SC PC PATIENT ASSIGN/UNASSIGN - protocol was disabled.")
  1.  DO MES^XPDUTL(" ")
  1.  QUIT
  1.  ;
  1. RESTORE ;UnSet option out-of-order
  1.  ;
  1.  ;  OPT - Menu option to mark out-of-order
  1.  ;  TXT - Out-of-order message text
  1.  ;
  1.  N I,OPT,TXT
  1.  S TXT=""
  1.  ;
  1.  ;Set up FOR loop to process each OOO option
  1.  ;
  1.  F I=1:1 S OPT=$P($TEXT(OPTLIST+I),";;",2) Q:OPT="$$END"!(OPT="")   D
  1.  . D OUT^XPDMENU(OPT,TXT)  ;UnMark option out-of-order
  1.  W !!,"Legacy PCMM options were unmarked Out-of-Order.",!
  1.  ;
  1.  QUIT
  1.  ;
  1. SECMENU ; Change New Person Records that have SCMC PCMM GUI WORKSTATION to SCMC PCMMR WEB USER MENU
  1.  ;
  1.  NEW SCGUIIEN,SCWEBIEN,SCDUZ,SCSECIEN,SCIENS,SCFDA,SCERR
  1.  NEW SCGUINM,SCWEBNM
  1.  SET SCGUINM="SCMC PCMM GUI WORKSTATION"
  1.  SET SCWEBNM="SCMC PCMMR WEB USER MENU"
  1.  ;
  1.  SET SCGUIIEN=$$FIND1^DIC(19,"","BX",SCGUINM,"","","")
  1.  SET SCWEBIEN=$$FIND1^DIC(19,"","BX",SCWEBNM,"","","")
  1.  QUIT:'SCGUIIEN
  1.  QUIT:'SCWEBIEN
  1.  ;
  1.  WRITE !,"This routine will convert a user's Seconary Menu Option from",!
  1.  WRITE "SCMC PCMM GUI WORKSTATION to SCMC PCMMR WEB USER MENU",!
  1.  ;
  1.  SET ^XTMP("SCMC-SECMENU",0)=$$FMADD^XLFDT($$DT^XLFDT(),180)_U_$$DT^XLFDT()_U_"Convert PCMM Users Secondary Menu Option"
  1.  SET SCDUZ=0
  1.  FOR  SET SCDUZ=$ORDER(^VA(200,SCDUZ)) QUIT:'+SCDUZ  DO
  1.  . SET SCSECIEN=0
  1.  . FOR  SET SCSECIEN=$ORDER(^VA(200,SCDUZ,203,SCSECIEN)) QUIT:'+SCSECIEN  DO
  1.  . . SET SCIENS=SCSECIEN_","_SCDUZ_","
  1.  . . IF $$GET1^DIQ(200.03,SCIENS,.01,"I")=SCGUIIEN DO  ;if = SCMC PCMM GUI WORKSTATION
  1.  . . . ;change it to SCMC PCMMR WEB USER MENU
  1.  . . . NEW SCFDA
  1.  . . . SET SCFDA(200.03,SCIENS,.01)=SCWEBIEN
  1.  . . . SET SCFDA(200.03,SCIENS,2)=""
  1.  . . . DO FILE^DIE("K","SCFDA","SCERR")
  1.  . . . SET ^XTMP("SCMC-SECMENU",SCDUZ)=$$GET1^DIQ(200,SCDUZ,.01)
  1.  ;
  1.  ;list
  1.  WRITE !!,"Users with Secondary Menu Option - SCMC PCMMR WEB USER MENU",!
  1.  SET SCDUZ=0
  1.  FOR  SET SCDUZ=$ORDER(^VA(200,SCDUZ)) QUIT:'+SCDUZ  DO
  1.  . SET SCSECIEN=0
  1.  . FOR  SET SCSECIEN=$ORDER(^VA(200,SCDUZ,203,SCSECIEN)) QUIT:'+SCSECIEN  DO
  1.  . . SET SCIENS=SCSECIEN_","_SCDUZ_","
  1.  . . IF $$GET1^DIQ(200.03,SCIENS,.01,"I")=SCWEBIEN DO  ;if = SCMC PCMMR WEB USER MENU
  1.  . . . WRITE "DUZ: ",SCDUZ,"     NAME: ",$$GET1^DIQ(200,SCDUZ,.01),!
  1.  ;
  1.  QUIT
  1.  ;
  1. RESTMENU ; Change New Person Records that have SCMC PCMMR WEB USER MENU to SCMC PCMM GUI WORKSTATION
  1.  ;
  1.  NEW SCGUIIEN,SCWEBIEN,SCDUZ,SCSECIEN,SCIENS,SCFDA,SCERR
  1.  NEW SCGUINM,SCWEBNM
  1.  SET SCGUINM="SCMC PCMM GUI WORKSTATION"
  1.  SET SCWEBNM="SCMC PCMMR WEB USER MENU"
  1.  ;
  1.  SET SCGUIIEN=$$FIND1^DIC(19,"","BX",SCGUINM,"","","")
  1.  SET SCWEBIEN=$$FIND1^DIC(19,"","BX",SCWEBNM,"","","")
  1.  QUIT:'SCGUIIEN
  1.  QUIT:'SCWEBIEN
  1.  ;
  1.  ;list
  1.  WRITE !,"This routine will convert a user's Seconary Menu Option from",!
  1.  WRITE "SCMC PCMMR WEB USER MENU to SCMC PCMM GUI WORKSTATION",!
  1.  WRITE !,"Users with Secondary Menu Option - SCMC PCMMR WEB USER MENU",!
  1.  SET SCDUZ=0
  1.  FOR  SET SCDUZ=$ORDER(^VA(200,SCDUZ)) QUIT:'+SCDUZ  DO
  1.  . SET SCSECIEN=0
  1.  . FOR  SET SCSECIEN=$ORDER(^VA(200,SCDUZ,203,SCSECIEN)) QUIT:'+SCSECIEN  DO
  1.  . . SET SCIENS=SCSECIEN_","_SCDUZ_","
  1.  . . IF $$GET1^DIQ(200.03,SCIENS,.01,"I")=SCWEBIEN DO  ;if = SCMC PCMMR WEB USER MENU
  1.  . . . WRITE "DUZ: ",SCDUZ,"     NAME: ",$$GET1^DIQ(200,SCDUZ,.01),!
  1.  ;
  1.  NEW DIR,X,Y,DIRUT
  1.  SET DIR(0)="Y"
  1.  SET DIR("A")="Do you want to convert now"
  1.  SET DIR("B")="NO"
  1.  DO ^DIR
  1.  QUIT:$DATA(DIRUT)
  1.  QUIT:'Y
  1.  ;
  1.  ;convert
  1.  SET ^XTMP("SCMC-SECMENU2",0)=$$FMADD^XLFDT($$DT^XLFDT(),180)_U_$$DT^XLFDT()_U_"UnConvert PCMM Users Secondary Menu Option"
  1.  SET SCDUZ=0
  1.  FOR  SET SCDUZ=$ORDER(^VA(200,SCDUZ)) QUIT:'+SCDUZ  DO
  1.  . SET SCSECIEN=0
  1.  . FOR  SET SCSECIEN=$ORDER(^VA(200,SCDUZ,203,SCSECIEN)) QUIT:'+SCSECIEN  DO
  1.  . . SET SCIENS=SCSECIEN_","_SCDUZ_","
  1.  . . IF $$GET1^DIQ(200.03,SCIENS,.01,"I")=SCWEBIEN DO  ;if = SCMC PCMMR WEB USER MENU
  1.  . . . ;change it to SCMC PCMMR WEB USER MENU
  1.  . . . NEW SCFDA
  1.  . . . SET SCFDA(200.03,SCIENS,.01)=SCGUIIEN
  1.  . . . SET SCFDA(200.03,SCIENS,2)=""
  1.  . . . DO FILE^DIE("K","SCFDA","SCERR")
  1.  . . . SET ^XTMP("SCMC-SECMENU2",SCDUZ)=$$GET1^DIQ(200,SCDUZ,.01)
  1.  ;
  1.  ;list again
  1.  WRITE !!,"Users with Secondary Menu Option - SCMC PCMM GUI WORKSTATION",!
  1.  SET SCDUZ=0
  1.  FOR  SET SCDUZ=$ORDER(^VA(200,SCDUZ)) QUIT:'+SCDUZ  DO
  1.  . SET SCSECIEN=0
  1.  . FOR  SET SCSECIEN=$ORDER(^VA(200,SCDUZ,203,SCSECIEN)) QUIT:'+SCSECIEN  DO
  1.  . . SET SCIENS=SCSECIEN_","_SCDUZ_","
  1.  . . IF $$GET1^DIQ(200.03,SCIENS,.01,"I")=SCGUIIEN DO  ;if = SCMC PCMM GUI WORKSTATION
  1.  . . . WRITE "DUZ: ",SCDUZ,"     NAME: ",$$GET1^DIQ(200,SCDUZ,.01),!
  1.  ;
  1.  QUIT
  1.  ;
  1. OPTLIST ;OPTIONS LIST
  1.  ;;SCMC PATIENT ASSIGN/UNASSIGN
  1.  ;;SCMC CLEAN GHOST ENTRIES
  1.  ;;SCMC CLEAN INSTITUTION
  1.  ;;SCMC CONVERSION TOOLS MENU
  1.  ;;SCMC EXTEND A PATIENT
  1.  ;;SCMC FLAGGED
  1.  ;;SCMC MU MASS TEAM UNASSIGNMENT
  1.  ;;SCMC PC ATTENDING CONVERSION
  1.  ;;SCMC PCMM BASELINE SEEDING
  1.  ;;SCMC PCMM EDIT PRACTIT #404.52
  1.  ;;SCMC PCMM NIGHTLY TASK
  1.  ;;SCMC PRECEPTOR CONVERSION
  1.  ;;SCMC PRECEPTOR MIGRATION RPT
  1.  ;;SCMC RETRANSMIT
  1.  ;;SCMC PCMM GUI WORKSTATION
  1.  ;;SCMC PC ATTENDING ASGN RPT
  1.  ;;$$END
  1.  ;
  1. PROTLIST ;PROTOCOLS LIST
  1.  ;;SC PC PATIENT ASSIGN/UNASSIGN
  1.  ;;$$END
  1.  ;