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

VENPCCQ8.m

Go to the documentation of this file. 
  1. VENPCCQ8 ; IHS/OIT/GIS - BUILD VALIDATION ROUTINE ;  [ 03/05/09   4:34 PM ]
  1.  ;;2.6;PCC+;**1,4,5**;APR 03, 2012;Build 24
  1.  ;
  1.  ;
  1.  ; VALIDATE PCC+ GUI INSTALLATION ; CAN ONLY BE RUN AFTER FULL KIDS INSTALL HAS BEEN COMPLETED ; 
  1.  ;
  1.  ; 
  1. CSC261 ; EP - VALIDATE PCC+ 2.6 PATCH 1: WCM GUI
  1.  N %
  1.  S %="PCC+*2.6*1" D VALIDATE(%)
  1.  Q
  1.  ; 
  1. VALIDATE(BIEN,MODE,OK,ERR) ; EP - VALIDATE WCM CONTENT
  1.  I $G(BIEN),$G(MODE)
  1.  E  S ERR=1 Q
  1.  N X,Y,Z,%,RTN,FIEN,RPC
  1.  S OK=0,ERR=0
  1.  ; 
  1. RTN W !,"Checking required ROUTINES..."
  1.  S RTN="",OK=0
  1.  F  S RTN=$O(^XPD(9.6,BIEN,"KRN",9.8,"NM","B",RTN)) Q:RTN=""  D
  1.  . X ("I $L($T(^"_RTN_"))")
  1.  . E  W !?5,U,RTN," is missing!" S OK=1,ERR=1
  1.  . Q
  1.  I 'OK D
  1.  . W "   < All ROUTINES installed"
  1.  . I $L($T(^VENCS265)) D
  1.  .. W !,"ROUTINE checksum verification..."
  1.  .. D CSUM^VENCS265(.OK)
  1.  .. I OK S ERR=1,OK=0 W !?5,"Integrity check violation!!" Q
  1.  .. W "  < All ROUTINES passed"
  1.  .. Q
  1.  I $$STOP S OK=2 Q
  1.  I MODE'=2 G FILE ; BYPASS DATA ENTRY RTN CHECK IF WCM USED IN EHR OR DEKTOP MODE
  1.  ; 
  1. FILE W !,"Checking required FILES..."
  1.  S FIEN=0,OK=0
  1.  F  S FIEN=$O(^XPD(9.6,BIEN,4,"B",FIEN)) Q:'FIEN  D
  1.  . I $D(^DD(FIEN,0)) Q
  1.  . W !?5,"File ",FIEN," is missing!"
  1.  . S OK=1,ERR=1
  1.  . Q
  1.  I 'OK W "   < All FILES present"
  1.  I $P($G(^VEN(7.14,5,0)),U,2)'=15.64 D  ; IHS/OIT/GIS  2/6/2012
  1.  . I OK W !
  1.  . W "   < The VEN EHP ASQ QUESTIONNAIRE file has not been updated!"
  1.  . S OK=1,ERR=1
  1.  . Q
  1.  I $$STOP S OK=2 Q
  1.  ; 
  1. MEAS W !,"Checking MEASUREMENT TYPES..."
  1.  D BADASQP ; CLEAN OUT CORRUPTED MEASUREMENT TYPE ASQP
  1.  S OK=0
  1.  S %="AFGLMPS"
  1.  F I=1:1:$L(%) D  ; ASQ MEASUREMENT VERIFICATION AND VALIDATION TAG
  1.  . S X=$E(%,I)
  1.  . S Y=$O(^AUTTMSR("B",("ASQ"_X),0))
  1.  . I 'Y S OK=1,ERR=1 W !?5,"Measurement type ASQ"_X_" is missing!" Q
  1.  . I X="M" S ^AUTTMSR(Y,12)="I X'?1.2N K X" Q
  1.  . S ^AUTTMSR(Y,12)="D ASQX^VENPCCQ"
  1.  . Q
  1.  I 'OK W "   < All MEASUREMENT TYPES present"
  1.  I $$STOP S OK=2 Q
  1.  ; 
  1. KEY W !,"Checking SECURITY KEYS..."
  1.  S KEY="",OK=0
  1.  F  S KEY=$O(^XPD(9.6,BIEN,"KRN",19.1,"NM","B",KEY)) Q:KEY=""  D
  1.  . I $O(^DIC(19.1,"B",KEY,0)) Q
  1.  . W !?5,"The key ",KEY," is missing!"
  1.  . S OK=1,ERR=1
  1.  . Q
  1.  I 'OK W "   < All KEYS present"
  1.  E  S ERR=1
  1.  I $$STOP S OK=2 Q
  1.  ;
  1. OPT W !,"Checking OPTIONS..."
  1.  S OPT="",OK=0
  1.  F  S OPT=$O(^XPD(9.6,BIEN,"KRN",19,"NM","B",OPT)) Q:OPT=""  D
  1.  . I $O(^DIC(19,"B",OPT,0)) Q
  1.  . W !?5,"The option ",OPT," is missing!"
  1.  . S OK=1,ERR=1
  1.  . Q
  1.  I MODE=2 G KEY
  1.  S BOIEN=$O(^DIC(19,"B","VEN RPC",0))
  1.  I 'BOIEN S ERR=1,OK=1,ERR=1 W !?5,"The broker option 'VEN RPC' is missing"
  1.  I 'OK W "   < All OPTIONS present"
  1.  I $$STOP S OK=2 Q
  1.  ; 
  1. RPC W !,"Checking REMOTE PROCEDURE CALLS..."
  1.  N RIEN
  1.  S RPC="",OK=0
  1.  F  S RPC=$O(^XPD(9.6,BIEN,"KRN",8994,"NM","B",RPC)) Q:RPC=""  D
  1.  . S RIEN=$O(^XWB(8994,"B",RPC,0))
  1.  . I 'RIEN D  Q
  1.  .. W !?5,"The RPC ",RPC," is missing!"
  1.  .. S OK=1,ERR=1
  1.  .. Q
  1.  . I 'BOIEN  S OK=1 Q
  1.  . I $O(^DIC(19,BOIEN,"RPC","B",RIEN,0)) Q
  1.  . D BOR(BOIEN,RIEN,RPC,.OK) ; REGISTER THE RPC IN BROKER OPTION 'VEN RPC'
  1.  . Q
  1.  I 'OK,MODE=1 D CIABMX^VENPCCQ7(.OK) ; CHECK THE RPC FOR BMX 4.0
  1.  I OK S ERR=1
  1.  I 'OK W "   < All RPCs present and registered"
  1.  I 'BOIEN W !?5,"Because broker option 'VEN RPC' is missing.  No RPCs can be registered."
  1.  I $$STOP S OK=2 Q
  1.  I MODE'=2 G CSCX
  1.  ;
  1. DIE W !,"Checking INPUT TEMPLATES: "
  1.  S OK=0
  1.  S X="APCD WC (ADD)^APCD WC (MOD)",Z=0
  1.  F PCE=1:1:$L(X,U) D
  1.  . S Y=$P(X,U,PCE)
  1.  . S %=$O(^DIE("B",Y,0))
  1.  . I '% W !?5,"The input template ",Y," is missing!" S OK=1 Q
  1.  . S Y=$NA(^DIE(%,"ROU"))
  1.  . S @Y="^VENPCCQB" ; SET COMPLIED INPUT TEMPLATE NODE
  1.  . Q
  1.  I OK S OK=0,ERR=1
  1.  E  W "  < All required INPUT TEMPLATES present"
  1.  I $$STOP S OK=2 Q
  1.  ; 
  1. MN W !,"Checking DATA ENTRY MNEMONICS: "
  1.  I '$O(^APCDTKW("B","WCE",0)) W !?10,"The data entry mnemonic 'WCE' is missing!" S ERR=1
  1.  E  W "  < All required MNEMONICS present"
  1.  I $$STOP S OK=2 Q
  1.  Q
  1.  ; 
  1. CSCX ; FINISH UP
  1.  I $G(ERR) W !!,"The Well Child GUI validation process detected at least one problem",! S X="Please take corrective action and reinstall this patch." G EXITMSG
  1.  I $G(OK)=2 W !!,"The validation process was terminated prematurely!",!,"Please complete the validation at a later time"
  1.  I '$G(OK),'$G(ERR)
  1.  E  I $$STOP Q
  1. SUCCESS S X="Congratulations!  The Well Child GUI module has been VALIDATED"
  1. EXITMSG D BOX(X)
  1.  Q
  1.  ;
  1. BOX(X) ; EP - HIGHLIGHT TEXT INSIDE A * BOX
  1.  I $G(X)="" Q
  1.  I $L(X)>73 Q
  1.  N Y,Z,%
  1.  S %=$L(X)+1
  1.  S Y="",$P(Y," ",%)="",Z="",$P(Z,"*",%+6)=""
  1.  S X="*  "_X_"  *",Y="*  "_Y_"  *"
  1.  W !!!,Z,!,Y,!,X,!,Y,!,Z,!!
  1.  Q
  1.  ; 
  1. BMX(OK) N %,BIEN,X,Y,Z,STG
  1.  S OK=0
  1.  W !!,"Checking BMX.NET..."
  1.  I '$L($T(^BMXEHR)) D  Q
  1.  . W !!,"Uh oh!..."
  1.  . W !,"The BMX.NET Broker package (Ver 3.0 or higher) has not been installed."
  1.  . W !,"Well Child Module GUI installation aborted!!!"
  1.  . W !,"Install the BMX.NET Broker package now, and then rerun this KIDS build"
  1.  . S OK=1,ERR=1
  1.  . Q
  1.  I 'OK W "  < Broker installed"
  1. BMXSCH W !,"Checking BMX SCHEMAS..."
  1.  S OK=0
  1.  I '$O(^BMXADO("B","VEN CF VISIT LIST",0)) S OK=1,ERR=1 W !?5,"The schema 'VEN CF VISIT LIST' is missing!!"
  1.  E  W "   < All BMX SCHEMAS are present"
  1.  Q
  1.  ; 
  1. BROKER ; EP - IF USING DESKTOP, CONFIGURE THE BROKER
  1.  W !!,"The BMX Broker must be running continuously to enable the WCM desktop"
  1.  W !?5,"You must start the BMX Broker each time the RPMS server is re-booted"
  1.  W !?5,"The BMXNet Management menu has options to START and STOP the BMX Broker"
  1. BMXMON W !!,"Checking BMX PORT MONITOR..." ; IF USING DESKTOP VERSION, LISTENER MUST BE REGISTERED AND STARTED
  1.  I '$O(^BMXMON(0)) D  Q
  1.  . W !!,"Currently, there are no ports assigned to the BMX MONITOR"
  1.  . W !?5,"Please assign a port number for this namespace"
  1. PORT . S DIR(0)="NO^1:63999:0",DIR("A")="Port number" KILL DA D ^DIR KILL DIR
  1.  . I 'Y D  Q
  1.  .. W !!,"The WCM will not be functional without an active BMX Monitor port"
  1.  .. W !,"Use the EDIT option on the BMXNet Management menu to register a port"
  1.  .. W !,"Use the STRT option on the BMXNet Management menu to activate a port"
  1.  .. Q
  1.  . Q
  1.  S BIEN=0,STG=""
  1.  F  S BIEN=$O(^BMXMON(BIEN)) Q:'BIEN  D
  1.  . S Z=+$G(^BMXMON(BIEN,0)) I 'Z Q
  1.  . I STG'="" S STG=STG_", "
  1.  . S STG=STG_Z
  1.  . Q
  1.  I STG["," W !!,"The following ports have been assigned to BMX: ",!?5
  1.  E  W !!,"The following port has been assigned to BMX: "
  1.  W STG
  1.  W !,"Use the STRT option on the BMXNet Management menu to activate a port"
  1.  Q
  1.  ; 
  1. STOP() W !,"<>" ; EP - WAIT
  1.  R %:DTIME
  1.  I %?1."^" Q 1
  1.  W $C(13),"             ",$C(13)
  1.  Q 0
  1.  ; 
  1. SBMX ; EP - OPTION: VEN WCM START OR STOP BROKER
  1.  N %,%Y,X,Y,Z,DIR,PORT
  1.  S DIR(0)="NO^5000:99999:",DIR("A")="Enter BMX port",DIR("B")="9200"
  1.  D ^DIR I Y'>1 Q
  1.  S PORT=+Y
  1. BSTART I $$SEMAPHOR^BMXMON(PORT,"LOCK") D  S %=$$STOP Q  ; START THE BROKER
  1.  . S %=1
  1.  . W !!,"Want to start the BMX broker listener now"
  1.  . D YN^DICN I %'=1 Q
  1.  . W !!
  1.  . D STRT^BMXMON(PORT)
  1.  . Q
  1. BSTOP ; STOP THE BROKER
  1.  W !!,"The BMX broker listener is currently running on port "_PORT,!," Want to stop it" ; STOP THE BROKER
  1.  S %=1
  1.  D YN^DICN I %'=1 Q
  1.  W !!
  1.  D STOP^BMXMON(PORT)
  1.  I $$STOP
  1.  Q
  1.  ;
  1. HDR ; EP - OPTION HEADER
  1.  W !?10,"WCM GUI Management"
  1.  W !,"----------------------------------------------------------",!!
  1.  Q
  1.  ; 
  1. BOR(BOIEN,RIEN,RPC,OK) ; EP - REGISTER A WCM RPC IN THE BROKER OPTION VEN RPC
  1.  I $G(BOIEN),$G(RIEN),$G(RPC)'=""
  1.  E  Q
  1.  N X,Y,Z,DIC,DIE,DA,DR,DLAYGO,%
  1.  S DA(1)=BOIEN
  1.  S DIC="^DIC(19,"_DA(1)_",""RPC"","
  1.  S (DIC("P"),DLAYGO)=19.05
  1.  S X="`"_RIEN,DIC(0)="LO"
  1.  D ^DIC
  1.  I Y=-1 W !?5,"RPC '",RPC,"' is not registered in broker option VEN RPC" S OK=1,ERR=1
  1.  D ^XBFMK
  1.  Q
  1.  ; 
  1. BADASQP ; EP - FIX SITES THAT HAD ALPHA VERSION OF 2.6 WITH CORRUPT ASQP
  1.  N %
  1.  N DIC,DIE,DA,DR,X,Y,Z,DLAYGO,TYPE,IEN,CODE
  1.  S (DIC,DIE,DLAYGO)=9999999.07,DIC(0)="LO",DA="",IEN=""
  1.  F  S DA=$O(^AUTTMSR("B","ASQP",DA)) Q:'DA  D
  1.  . S TYPE=$P($G(^AUTTMSR(DA,0)),U,2) I TYPE="" Q
  1.  . I TYPE="ASQ - PROBLEM SOLVING" S IEN=DA Q
  1.  . I TYPE="ASQ PROBLEM SOLVING" D  Q  ; DEACTIVATE THE BAD MEASUREMENT
  1.  .. S TYPE="ZSQ",CODE="00"
  1.  .. S DR=".01////^S X=TYPE;.02////^S X=TYPE;.03////^S X=CODE;.04////^S X=1"
  1.  .. L +^AUTTMSR(DA):1 I  D ^DIE L -^AUTTMSR(DA)
  1.  .. Q
  1.  . Q
  1.  I IEN D ^XBFMK Q  ; THE GOOD MEASUREMENT IS ALREADY IN THERE SO QUIT
  1.  ; NEED TO REGISTER THE GOOD MEASUREMENT
  1.  S X="ASQP",TYPE="ASQ - PROBLEM SOLVING",CODE=64
  1.  D ^DIC I Y=-1 Q
  1.  S DA=+Y,DR=".02////^S X=TYPE;.03////^S X=CODE"
  1.  L +^AUTTMSR(DA):1 I  D ^DIE L -^AUTTMSR(DA)
  1.  D ^XBFMK
  1.  Q
  1.  ; 
  1. BOPT(OK) ; EP - PLACE BROKER OPTION ON PRIMARY MENU OR ASSIGN IT TO INDIVIDUAL PROVIDER AS A SECONDARY MENU
  1.  S OK=0
  1.  N DIK,X,Y,Z,%,OIEN
  1.  S OIEN=$O(^DIC(19,"B","VEN RPC",0))
  1.  I 'OIEN W !!,"Unable to find VEN RPC in the OPTION file!",!! Q
  1.  W !,"A user must have broker option VEN RPC to use the Well Child Module!!!"
  1.  W !!?5,"1. Add VEN RPC option to the Primay Menu(s) of WCM users (recommended)"
  1.  W !?5,"2. Assign VEN RPC to individual users as a seconday menu option"
  1.  W !?5,"3. Quit"
  1.  S DIR(0)="NO^1:3:",DIR("A")="Your choice" D ^DIR K DIR
  1.  I Y=1 D BOPT1(OIEN,.OK) Q
  1.  I Y=2 D BOPT2(OIEN,.OK)
  1.  Q
  1.  ; 
  1. BOPT1(OIEN,OK) ; ADD VEN RPC TO PRIMARY MENU(S)
  1.  N DIC,DA,X,Y,Z,%,MORE,RIEN,DA,DR,DLAYGO,PIEN,DO,GBL
  1.  S MORE=0
  1. LOOP1 I 'MORE S DIC("A")="Enter a primary menu assigned to WCM users: ",MORE=1
  1.  E  S DIC("A")="Enter another primary menu assigned to WCM users: "
  1.  S DIC="^DIC(19,",DIC(0)="AEQM"
  1.  D ^DIC I Y=-1 D ^XBFMK Q
  1.  K DIC("A"),DO,DO(2)
  1.  S (D0,DA(1))=+Y,DIC="^DIC(19,"_DA(1)_",10,",DIC(0)="LO",X="`"_OIEN,(DLAYGO,DIC("P"))=19.01
  1.  D ^DIC I Y=-1 W !?5,"Unable to add VEN RPC to this primary menu" S OK=1 Q
  1.  I $P(Y,U,3)="" W !?5,"VEN RPC has already been added to this menu",! G LOOP1
  1.  S GBL=$NA(^DIC(19,DA(1),10,+Y))
  1.  S $P(@GBL@(0),U,2)="WCM"
  1.  W !?5,"ADDED",!
  1.  G LOOP1
  1.  ; 
  1. BOPT2(OIEN,OK) ; ADD VEN RPC TO PRIMARY MENU(S)
  1.  N DIC,DA,X,Y,Z,%,MORE,RIEN,DA,DR,DLAYGO,PIEN,DO,GBL
  1.  S MORE=0
  1. LOOP2 I 'MORE S DIC("A")="Enter a WCM user: ",MORE=1
  1.  E  S DIC("A")="Enter another WCM user: "
  1.  S DIC="^VA(200,",DIC(0)="AEQM"
  1.  D ^DIC I Y=-1 D ^XBFMK Q
  1.  K DIC("A"),DO,DO(2)
  1.  S (D0,DA(1))=+Y,DIC="^VA(200,"_DA(1)_",203,",DIC(0)="LO",X="`"_OIEN,(DLAYGO,DIC("P"))=200.03
  1.  D ^DIC I Y=-1 W !?5,"Unable to assign this secondary menu option to the user" S OK=1 Q
  1.  I $P(Y,U,3)="" W !?5,"VEN RPC has already been assigned to the user",! G LOOP2
  1.  S GBL=$NA(^DIC(19,DA(1),10,+Y))
  1.  S $P(@GBL@(0),U,2)="VENR"
  1.  W !?5,"VEN RPC has been assigned as a secondary menu to this user",!
  1.  G LOOP2
  1.  ;