VENPCCQX ; IHS/OIT/GIS - POST INSTALL & APPLICATION CONFIG OPTION ; [ 03/05/09 4:34 PM ]
;;2.6;PCC+;**1,3**;MAR 23, 2011
;
;
;
CSCX N CNT D CSC(.CNT) I '$G(CNT) W !,"Enjoy the well child module..." ; POST INIT ENTRY POINT
D PAUSE^VENPCCU
Q
;
CSC(CNT) ; EP - ENVIRONMENT CHECKER FOR VER 2.6
N X,Y,Z,%,PCE,FILE,SUB,MEAS,DIEN,TOT,DA,DR,DIE,DIK,DDER,BIEN,MIEN,%Y,DLAYGO,IEN,PCE,A
S CNT=0,Z=0
W !,"Checking all the components of the Well Child Module...",!
W !,"After each section, press the <RETURN> key when you see the '<>' symbol",!!!
RTN W !,"CHECKING WCM ROUTINES: "
S X="^VENPCCQ,^VENPCCQ1,^VENPCCQA,^VENPCCQB,^VENPCCQC,^VENPCCQD,^VENPCCQY,^VENPCCQZ,"
S X=X_"^VENPCCK,^VENPCCK1,^VENPCCKB,^VENPCCKX,^VENPCC1M,^VENKINIT,^VENLINIT,^VENMINIT"
F PCE=1:1:$L(X,",") D
. S Y=$P(X,",",PCE)
. S %=$P(Y,U,2) I '$L(%) Q
. X "I $L($T("_Y_"))"
. I W !?10,%,?20,"<- OK" Q
. W !?10,"The routine ",%," is missing!"
. S Z=1
. Q
W !
I Z S Z=0,CNT=CNT+1
E W !,?5,"All required routines have been successfully installed"
W ! I '$$WAIT G BAIL
D XRT^VENPCCQZ
W ! I '$$WAIT G BAIL
KB W !,"UPDATING KNOWLEDGEBASE"
I $O(^VEN(7.12,999999),-1)>3000 W !?10,"Well child knowledgebase is installed" G KB1 ; KB IS UP TO DATE
I '$L($T(^VENKINIT)) G VPTED^VENPCCQZ ; NEW PT ED FILE
W !!,"When asked if you want to overwrite security codes, answer 'NO'"
W !,"When asked if everything is OK, answer 'YES'",!!
CLEANUP ; FIRST CLEAN UP KB FILES, BUT LEAVE OLD KB ITEMS FROM VER 2.5
I $D(^VEN(7.12,0)) S DIK="^VEN(7.12,",DA=0 F S DA=$O(^VEN(7.12,DA)) Q:'DA I +$G(^VEN(7.12,DA,0))>7 D ^DIK
I $D(^VEN(7.11,0)) S DIK="^VEN(7.11,",DA=0 F S DA=$O(^VEN(7.11,DA)) Q:'DA D ^DIK
I $D(^VEN(7.13,0)) S DIK="^VEN(7.13,",DA=0 F S DA=$O(^VEN(7.13,DA)) Q:'DA D ^DIK
I $L($T(^VENKINIT)) D ^VENKINIT W ! ; RESTORE KB FILES AND CONTENT!
KB1 D DINFO^VENPCCQZ W ! ; CHECK/FIX KB POINTERS
I '$$WAIT G BAIL
FILE W !,"CHECKING FILES: "
S Z=0
S X="9000010.161^9000010.46^90093.99^19707.11^19707.12^19707.13^19707.14,19707.4119"
F PCE=1:1:$L(X,U) D
. S Y=+$P(X,U,PCE)
. S FILE=$P($G(^DIC(Y,0)),U)
. I Y=19707.4119 S FILE="VEN EHP EF TEMPLATES"
. I Y=9000010.161 S FILE="V PATIENT ED"
. I $D(^DD(Y)) W !?10,"File: ",FILE," <- OK" Q
. I Y=9000010.46,$L($T(^VENMINIT)) D VWC^VENPCCQZ Q ; ADD V WELL CHILD FILE
. I Y=9000010.161,$L($T(^VENLINIT)) D VPTED^VENPCCQZ Q ; UPDATE V PATIENT ED
. W !?10,"File: ",FILE," <- LATEST VERSION NOT FOUND!!!" S Z=1
. Q
W !
I Z S Z=0,CNT=CNT+1
E W !,?5,"All required files have been successfully installed"
W ! I '$$WAIT G BAIL
PTED W !,"CHECKING PAITENT EDUCATION CODES: "
D TOPIC^VENPCCKB
W !,?5,"All required patient education codes have been successfully installed"
W ! I '$$WAIT G BAIL
MSR W !,"CHECKING MEASUREMNT TYPES: "
S X="ASQL^ASQG^ASQF^ASQP^ASQS^ASQM"
F PCE=1:1:$L(X,U) D
. S Y=$P(X,U,PCE)
. S %=+$O(^AUTTMSR("B",Y,0)) S MEAS=$P($G(^AUTTMSR(%,0)),U,2)
. I '$L(MEAS) W !?10,"The measurement ",Y," is missing!" S Z=1 Q
. W !?10,"Measurement: ",MEAS," <- OK" Q
. Q
I Z S Z=0,CNT=CNT+1
E W !,?5,"All required measurement types have been successfully installed"
W ! I '$$WAIT G BAIL
DIE W !,"CHECKING INPUT TEMPLATES: "
S X="APCD WC (ADD)^APCD WC (MOD)",Z=0
F PCE=1:1:$L(X,U) D
. S Y=$P(X,U,PCE)
. S %=$O(^DIE("B",Y,0))
. I '% W !?10,"The input template ",Y," is missing!" S Z=1 Q
. W !?10,"Input template: ",Y," <- OK"
. S Y=$NA(^DIE(%,"ROU"))
. S @Y="^VENPCCQB" ; SET COMPLIED INPUT TEMPLATE NODE
. Q
I Z S Z=0,CNT=CNT+1
E W !,?5,"All required input templates have been successfully installed"
W ! I '$$WAIT G BAIL
MN W !,"CHECKING DATA ENTRY MNEMONICS: "
S X="WCE"
F PCE=1:1:$L(X,U) D
. S Y=$P(X,U,PCE)
. I '$O(^APCDTKW("B",Y,0)) W !?10,"The data entry mnemonic ",Y," is missing!" S Z=1 Q
. W !?10,"Data entry mnemonic: ",Y," <- OK" Q
. Q
I Z S Z=0,CNT=CNT+1
E W !,?5,"All required data entry mnemonics have been successfully installed"
W ! I '$$WAIT G BAIL
RPC W !,"CHECKING REMOTE PROCEDURE CALLS: "
S X="VEN ASQ GET PATIENT ID^VEN ASQ GET DATA^VEN ASQ GET VISITS^VEN ASQ START TX^VEN ASQ FLUSH^BMX ADO SS"
S X=X_U_"VEN KB EDIT PTED^VEN KB EDIT DEV^VEN KB EDIT AUT^VEN KB EDIT EXAM"
F PCE=1:1:$L(X,U) D
. S Y=$P(X,U,PCE)
. I '$O(^XWB(8994,"B",Y,0)) W !?10,"The RPC ",Y," is missing!" S Z=1 Q
. W !?10,"RPC: ",Y," <- OK" Q
. Q
I Z S Z=0,CNT=CNT+1
E W !,?5,"All required RPCs have been successfully installed"
W ! I '$$WAIT G BAIL
OPT W !,"CHECKING OPTIONS: "
S X="BMXRPC^VEN RPC^VEN WCM ACTIVATE DOMAIN^VEN WCM PLACE BROKER OPTION"
S X=X_"^VEN WCM_MENU^VEN WCM START OR STOP BROKER"
F PCE=1:1:$L(X,U) D
. S Y=$P(X,U,PCE)
. I '$O(^DIC(19,"B",Y,0)) W !?10,"The Option ",Y," is missing!" S Z=1 Q
. W !?10,"Option : ",Y," <- OK" Q
. Q
I Z S Z=0,CNT=CNT+1
E W !,?5,"All required options have been successfully installed"
W ! I '$$WAIT G BAIL
KEY W !,"CHECKING SECURITY KEYS FOR THE KNOWLEDGEBASE EDITOR: "
S X="VENZKBEDIT"
F PCE=1:1:$L(X,U) D
. S Y=$P(X,U,PCE)
. I '$O(^DIC(19.1,"B",Y,0)) W !?10,"The Key ",Y," is missing!" S Z=1 Q
. W !?10,"Key : ",Y," <- OK"
. D HOLD^VENPCCQZ(Y) ; GET HOLDERS
. Q
I Z S Z=0,CNT=CNT+1
E W !,?5,"All required security keys have been successfully installed"
W ! I '$$WAIT G BAIL
HSMP W !,"CHECKING HEALTH SUMMARY MEASUREMENT PANEL: "
S X="ASQ DEVELOPMENT SCORES"
F PCE=1:1:$L(X,U) D
. S Y=$P(X,U,PCE)
. I '$O(^APCHSMPN("B",Y,0)) W !?10,"The data measurement panel ",Y," is missing!" S Z=1 Q
. W !?10,"Measurement panel: ",Y," <- OK" Q
. Q
MPF S X="5|M^10|L^20|G^30|F^40|P^50|S" ; CONFIRM MEASUREMNT PANEL FIELDS
F PCE=1:1:6 D
. S %=$P(X,U,PCE),Y=+%,A="ASQ"_$P(%,"|",2)
. S DA=$O(^APCHSMPN("B","ASQ DEVELOPMENT SCORES",0)) I 'DA Q
. S %=$NA(^APCHSMPN(DA,1))
. S DA=$O(^AUTTMSR("B",A,0)) I 'DA Q
. S $P(@%@(Y,0),U,2)=DA
. Q
I Z S Z=0,CNT=CNT+1
E W !,?5,"All required measurement panels have been successfully installed"
W ! I '$$WAIT G BAIL
WCE W !,"CHECKING HEALTH SUMMARY WELL CHILD EXAM COMPONENT: "
S X="WELL CHILD EXAM"
F PCE=1:1:$L(X,U) D
. S Y=$P(X,U,PCE)
. I '$O(^APCHSCMP("B",Y,0)) D ; IF KIDS FAILS
.. S DIC="^APCHSCMP(",DIC(0)="L",X="WELL CHILD EXAM" D ^DIC I Y=-1 Q
.. S DIE=DIC,DA=+Y,DR="1////^S X=TAG;2///NO",TAG="WCE;APCHS6B"
.. L +^APCHSCMP(DA):1 I D ^DIE L -^APCHSCMP(DA)
.. Q
. I '$O(^APCHSCMP("B",Y,0)) W !?10,"The health summary component ",Y," is missing!" S Z=1 Q
. W !?10,"Health summary component: ",Y," <- OK" Q
. Q
I Z S Z=0,CNT=CNT+1
E W !,?5,"The required components have been successfully installed"
W ! I '$$WAIT G BAIL
HS W !,"CHECKING WELL CHILD HEALTH SUMARY TYPE: "
S Y="WELL CHILD EXAM"
I '$O(^APCHSCTL("B",Y,0)) W !?10,"The health summary type ",Y," is missing!" S CNT=CNT+1 G MCK
W !?10,"Health summary type: ",Y," <- OK"
W !,?5,"The required health summary types have been successfully installed"
HSCMP S Z=0 D CMP^VENPCCQZ(.Z) I Z S Z=0,CNT=CNT+1 ; CHECK HS
D MP^VENPCCQZ ; MAKE SURE CORRECT MEASUREMENT PANELS ARE ASSIGNED TO THIS HEALTH SUMMARY TYPE
W ! I '$$WAIT G BAIL
BOC W !!,"CHECKING BROKER OPTION CONTENT"
S X="VEN ASQ GET PATIENT ID^VEN ASQ GET DATA^VEN ASQ GET VISITS^VEN ASQ START TX^VEN ASQ FLUSH^BMX ADO SS"
S X=X_U_"VEN KB EDIT PTED^VEN KB EDIT DEV^VEN KB EDIT AUT^VEN KB EDIT EXAM"
S IEN=$O(^DIC(19,"B","VEN RPC",0)) I 'IEN W !,"The broker option VEN RPC is missing" G HSMP
F PCE=1:1:$L(X,U) D
. S Y=$P(X,U,PCE)
. S %=$O(^XWB(8994,"B",Y,0))
. I '% W !?10,"RPC '",Y,"' has not been assigned to broker option VEN RPC" S Z=1 Q
. Q
I Z S Z=0,CNT=CNT+1
E W !,"All required RPCs have been assigned to broker option VEN RPC"
W ! I '$$WAIT G BAIL
MCK D MENU^VENPCCQZ ; ASSIGN BROKER OPTIONS TO EXISTING MENUS
D SMENU^VENPCCQZ ; ASSIGN THE BROKER OPTION TO INDIVIDUAL USERS AS A SECONDARY MENU
W ! I '$$WAIT G BAIL
D ACT
D OCX
FIN D ^XBFMK
I 'CNT W !!,"All required RPMS components are present and accounted for!" Q
W !!?20,"**** WARNING ****",!!,"One or more critical RPMS components is missing from the Well Child Module"
W !,"You may need to reinstall the system. Please check with the OIT help desk"
Q
;
OCX ; EP - REGISTER FORM IN THE OCX COMPONENT FILE - REQUIRED FOR ALL VERSIONS OF MEASUREMENT PLOTTING
N DIC,DLAYGO,DA,X,Y
S X=$O(^VEN(7.41,"B","WELL CHILD EXAM (NATL)",0)) I 'X Q
S DA(1)=$O(^VEN(7.62,"B","PEDS GROWTH CHART",0)) I 'DA(1) Q
S DIC="^VEN(7.62,"_DA(1)_",6,",DIC(0)="L"
S (DLAYGO,DIC("P"))=19707.626,X="`"_X
D ^DIC
Q
;
D MENU^VENPCCQZ
Q
;
CONVERT ; EP - CONVERT OLD WELL CHILD FORMS
W !!,"Checking all of your well child templates to see if they use",!,"the new knowledgebase format..."
N TIEN,X,Y,Z,%,DIC,DIE,DA,DR,CIEN,DOM,DIEN,TMPL
S TIEN=0,CIEN=$O(^VEN(7.11,"B","WELL CHILD NUTRITION",0))
F S TIEN=$O(^VEN(7.41,TIEN)) Q:'TIEN I '$O(^VEN(7.41,TIEN,19,0)),$D(^VEN(7.41,TIEN,16,"B",CIEN)) D
. S TMPL=$P($G(^VEN(7.41,TIEN,0)),U) I '$L(TMPL) Q
. W !?5,"OK to convert ",TMPL," to new format"
. S %=1 D YN^DICN
. I %'=1 Q
. S DA(1)=TIEN,DIC="^VEN(7.41,"_DA(1)_",19,"
. S DIC("P")=$P(^DD(19707.41,19,0),U,2),DLAYGO=+DIC("P"),DIC(0)="L"
. S DOM="WELL CHILD NATL"
. F S DOM=$O(^VEN(7.13,"B",DOM)) Q:DOM'["WELL CHILD NATL" D
.. S DIEN=$O(^VEN(7.13,"B",DOM,0)) I 'DIEN Q
.. S X="`"_DIEN
.. D ^DIC I Y=-1 Q
.. S %=$S(DOM[" DEV ":10,DOM[" AG ":20,DOM[" NUTR ":30,DOM[" EXAM ":40,1:"")
.. I % S $P(^VEN(7.41,TIEN,19,+Y,0),U,2)=% ; ORDER
.. Q
. W " <- OK"
. Q
D ^XBFMK
Q
;
ACT ; EP - ACTIVATE A DOMAIN
D ACT^VENPCCQZ
Q
;
ACTL ; EP - SHOW IF DOMAIN IS ACTIVE
S DIEN=0,TOT=0
F S DIEN=$O(^VEN(7.13,DIEN)) Q:'DIEN D
. S X=$G(^VEN(7.13,DIEN,0))
. S Y=$P(X,U) I Y'["WELL CHILD" Q
. S Z=$P(X,U,7),TOT=TOT+1,TOT(TOT)=DIEN
. W !?5,TOT,". ",Y," <-",$S(Z'=1:"IN",1:""),"ACTIVE"
. Q
Q
;
BAIL ; EP - ABORT THE SESSION
W !!,"Comprehensive check of the well baby module has been prematurely terminated!"
W !,"Please try again later..."
Q
;
WAIT() ; EP-WAIT STATE
N %
W "<>"
W1 R %:$G(DTIME,300) E Q 0
W $C(13),?79,$C(13)
I %?1."^" Q 0
I %?1."?" W "Press the <ENTER> key to keep scrolling or '^' to quit <>" G W1
Q 1
;
BRK ; EP - START/STOP THE BROKER
N %,%Y
W !!,"Want to start the WCM broker now" ; START THE BROKER
S %=1
D YN^DICN I %'=1 Q
D STRT^BMXMON(10501)
BRK1 ; STOP THE BROKER
W !!,"The broker is currently running. Want to stop it" ; STOP THE BROKER
S %=1
D YN^DICN I %'=1 Q
D STOP^BMXMON
Q
;
CIA(DA,OUT) ; EP - SCREEN CIA OBJECTS FOR KIDS BUILD
S OUT=""
I $D(DA)
E Q
N X,Y,Z,%
S X=$P($G(^CIAVOBJ(19930.2,DA,0)),U) I X="" Q
S Y=$E(X,1,8)
I Y="FILE:BMX" S OUT=1 Q
I Y="FILE:IND" S OUT=1 Q
I Y="FILE:INF" S OUT=1 Q
I Y="FILE:ITE" S OUT=1 Q
I Y="IHS.WCM." S OUT=1 Q
Q
;
VENPCCQX ; IHS/OIT/GIS - POST INSTALL & APPLICATION CONFIG OPTION ; [ 03/05/09 4:34 PM ]
+1 ;;2.6;PCC+;**1,3**;MAR 23, 2011
+2 ;
+3 ;
+4 ;
CSCX ; POST INIT ENTRY POINT
NEW CNT
DO CSC(.CNT)
IF '$GET(CNT)
WRITE !,"Enjoy the well child module..."
+1 DO PAUSE^VENPCCU
+2 QUIT
+3 ;
CSC(CNT) ; EP - ENVIRONMENT CHECKER FOR VER 2.6
+1 NEW X,Y,Z,%,PCE,FILE,SUB,MEAS,DIEN,TOT,DA,DR,DIE,DIK,DDER,BIEN,MIEN,%Y,DLAYGO,IEN,PCE,A
+2 SET CNT=0
SET Z=0
+3 WRITE !,"Checking all the components of the Well Child Module...",!
+4 WRITE !,"After each section, press the <RETURN> key when you see the '<>' symbol",!!!
RTN WRITE !,"CHECKING WCM ROUTINES: "
+1 SET X="^VENPCCQ,^VENPCCQ1,^VENPCCQA,^VENPCCQB,^VENPCCQC,^VENPCCQD,^VENPCCQY,^VENPCCQZ,"
+2 SET X=X_"^VENPCCK,^VENPCCK1,^VENPCCKB,^VENPCCKX,^VENPCC1M,^VENKINIT,^VENLINIT,^VENMINIT"
+3 FOR PCE=1:1:$LENGTH(X,",")
Begin DoDot:1
+4 SET Y=$PIECE(X,",",PCE)
+5 SET %=$PIECE(Y,U,2)
IF '$LENGTH(%)
QUIT
+6 XECUTE "I $L($T("_Y_"))"
+7 IF $TEST
WRITE !?10,%,?20,"<- OK"
QUIT
+8 WRITE !?10,"The routine ",%," is missing!"
+9 SET Z=1
+10 QUIT
End DoDot:1
+11 WRITE !
+12 IF Z
SET Z=0
SET CNT=CNT+1
+13 IF '$TEST
WRITE !,?5,"All required routines have been successfully installed"
+14 WRITE !
IF '$$WAIT
GOTO BAIL
+15 DO XRT^VENPCCQZ
+16 WRITE !
IF '$$WAIT
GOTO BAIL
KB WRITE !,"UPDATING KNOWLEDGEBASE"
+1 ; KB IS UP TO DATE
IF $ORDER(^VEN(7.12,999999),-1)>3000
WRITE !?10,"Well child knowledgebase is installed"
GOTO KB1
+2 ; NEW PT ED FILE
IF '$LENGTH($TEXT(^VENKINIT))
GOTO VPTED^VENPCCQZ
+3 WRITE !!,"When asked if you want to overwrite security codes, answer 'NO'"
+4 WRITE !,"When asked if everything is OK, answer 'YES'",!!
CLEANUP ; FIRST CLEAN UP KB FILES, BUT LEAVE OLD KB ITEMS FROM VER 2.5
+1 IF $DATA(^VEN(7.12,0))
SET DIK="^VEN(7.12,"
SET DA=0
FOR
SET DA=$ORDER(^VEN(7.12,DA))
IF 'DA
QUIT
IF +$GET(^VEN(7.12,DA,0))>7
DO ^DIK
+2 IF $DATA(^VEN(7.11,0))
SET DIK="^VEN(7.11,"
SET DA=0
FOR
SET DA=$ORDER(^VEN(7.11,DA))
IF 'DA
QUIT
DO ^DIK
+3 IF $DATA(^VEN(7.13,0))
SET DIK="^VEN(7.13,"
SET DA=0
FOR
SET DA=$ORDER(^VEN(7.13,DA))
IF 'DA
QUIT
DO ^DIK
+4 ; RESTORE KB FILES AND CONTENT!
IF $LENGTH($TEXT(^VENKINIT))
DO ^VENKINIT
WRITE !
KB1 ; CHECK/FIX KB POINTERS
DO DINFO^VENPCCQZ
WRITE !
+1 IF '$$WAIT
GOTO BAIL
FILE WRITE !,"CHECKING FILES: "
+1 SET Z=0
+2 SET X="9000010.161^9000010.46^90093.99^19707.11^19707.12^19707.13^19707.14,19707.4119"
+3 FOR PCE=1:1:$LENGTH(X,U)
Begin DoDot:1
+4 SET Y=+$PIECE(X,U,PCE)
+5 SET FILE=$PIECE($GET(^DIC(Y,0)),U)
+6 IF Y=19707.4119
SET FILE="VEN EHP EF TEMPLATES"
+7 IF Y=9000010.161
SET FILE="V PATIENT ED"
+8 IF $DATA(^DD(Y))
WRITE !?10,"File: ",FILE," <- OK"
QUIT
+9 ; ADD V WELL CHILD FILE
IF Y=9000010.46
IF $LENGTH($TEXT(^VENMINIT))
DO VWC^VENPCCQZ
QUIT
+10 ; UPDATE V PATIENT ED
IF Y=9000010.161
IF $LENGTH($TEXT(^VENLINIT))
DO VPTED^VENPCCQZ
QUIT
+11 WRITE !?10,"File: ",FILE," <- LATEST VERSION NOT FOUND!!!"
SET Z=1
+12 QUIT
End DoDot:1
+13 WRITE !
+14 IF Z
SET Z=0
SET CNT=CNT+1
+15 IF '$TEST
WRITE !,?5,"All required files have been successfully installed"
+16 WRITE !
IF '$$WAIT
GOTO BAIL
PTED WRITE !,"CHECKING PAITENT EDUCATION CODES: "
+1 DO TOPIC^VENPCCKB
+2 WRITE !,?5,"All required patient education codes have been successfully installed"
+3 WRITE !
IF '$$WAIT
GOTO BAIL
MSR WRITE !,"CHECKING MEASUREMNT TYPES: "
+1 SET X="ASQL^ASQG^ASQF^ASQP^ASQS^ASQM"
+2 FOR PCE=1:1:$LENGTH(X,U)
Begin DoDot:1
+3 SET Y=$PIECE(X,U,PCE)
+4 SET %=+$ORDER(^AUTTMSR("B",Y,0))
SET MEAS=$PIECE($GET(^AUTTMSR(%,0)),U,2)
+5 IF '$LENGTH(MEAS)
WRITE !?10,"The measurement ",Y," is missing!"
SET Z=1
QUIT
+6 WRITE !?10,"Measurement: ",MEAS," <- OK"
QUIT
+7 QUIT
End DoDot:1
+8 IF Z
SET Z=0
SET CNT=CNT+1
+9 IF '$TEST
WRITE !,?5,"All required measurement types have been successfully installed"
+10 WRITE !
IF '$$WAIT
GOTO BAIL
DIE WRITE !,"CHECKING INPUT TEMPLATES: "
+1 SET X="APCD WC (ADD)^APCD WC (MOD)"
SET Z=0
+2 FOR PCE=1:1:$LENGTH(X,U)
Begin DoDot:1
+3 SET Y=$PIECE(X,U,PCE)
+4 SET %=$ORDER(^DIE("B",Y,0))
+5 IF '%
WRITE !?10,"The input template ",Y," is missing!"
SET Z=1
QUIT
+6 WRITE !?10,"Input template: ",Y," <- OK"
+7 SET Y=$NAME(^DIE(%,"ROU"))
+8 ; SET COMPLIED INPUT TEMPLATE NODE
SET @Y="^VENPCCQB"
+9 QUIT
End DoDot:1
+10 IF Z
SET Z=0
SET CNT=CNT+1
+11 IF '$TEST
WRITE !,?5,"All required input templates have been successfully installed"
+12 WRITE !
IF '$$WAIT
GOTO BAIL
MN WRITE !,"CHECKING DATA ENTRY MNEMONICS: "
+1 SET X="WCE"
+2 FOR PCE=1:1:$LENGTH(X,U)
Begin DoDot:1
+3 SET Y=$PIECE(X,U,PCE)
+4 IF '$ORDER(^APCDTKW("B",Y,0))
WRITE !?10,"The data entry mnemonic ",Y," is missing!"
SET Z=1
QUIT
+5 WRITE !?10,"Data entry mnemonic: ",Y," <- OK"
QUIT
+6 QUIT
End DoDot:1
+7 IF Z
SET Z=0
SET CNT=CNT+1
+8 IF '$TEST
WRITE !,?5,"All required data entry mnemonics have been successfully installed"
+9 WRITE !
IF '$$WAIT
GOTO BAIL
RPC WRITE !,"CHECKING REMOTE PROCEDURE CALLS: "
+1 SET X="VEN ASQ GET PATIENT ID^VEN ASQ GET DATA^VEN ASQ GET VISITS^VEN ASQ START TX^VEN ASQ FLUSH^BMX ADO SS"
+2 SET X=X_U_"VEN KB EDIT PTED^VEN KB EDIT DEV^VEN KB EDIT AUT^VEN KB EDIT EXAM"
+3 FOR PCE=1:1:$LENGTH(X,U)
Begin DoDot:1
+4 SET Y=$PIECE(X,U,PCE)
+5 IF '$ORDER(^XWB(8994,"B",Y,0))
WRITE !?10,"The RPC ",Y," is missing!"
SET Z=1
QUIT
+6 WRITE !?10,"RPC: ",Y," <- OK"
QUIT
+7 QUIT
End DoDot:1
+8 IF Z
SET Z=0
SET CNT=CNT+1
+9 IF '$TEST
WRITE !,?5,"All required RPCs have been successfully installed"
+10 WRITE !
IF '$$WAIT
GOTO BAIL
OPT WRITE !,"CHECKING OPTIONS: "
+1 SET X="BMXRPC^VEN RPC^VEN WCM ACTIVATE DOMAIN^VEN WCM PLACE BROKER OPTION"
+2 SET X=X_"^VEN WCM_MENU^VEN WCM START OR STOP BROKER"
+3 FOR PCE=1:1:$LENGTH(X,U)
Begin DoDot:1
+4 SET Y=$PIECE(X,U,PCE)
+5 IF '$ORDER(^DIC(19,"B",Y,0))
WRITE !?10,"The Option ",Y," is missing!"
SET Z=1
QUIT
+6 WRITE !?10,"Option : ",Y," <- OK"
QUIT
+7 QUIT
End DoDot:1
+8 IF Z
SET Z=0
SET CNT=CNT+1
+9 IF '$TEST
WRITE !,?5,"All required options have been successfully installed"
+10 WRITE !
IF '$$WAIT
GOTO BAIL
KEY WRITE !,"CHECKING SECURITY KEYS FOR THE KNOWLEDGEBASE EDITOR: "
+1 SET X="VENZKBEDIT"
+2 FOR PCE=1:1:$LENGTH(X,U)
Begin DoDot:1
+3 SET Y=$PIECE(X,U,PCE)
+4 IF '$ORDER(^DIC(19.1,"B",Y,0))
WRITE !?10,"The Key ",Y," is missing!"
SET Z=1
QUIT
+5 WRITE !?10,"Key : ",Y," <- OK"
+6 ; GET HOLDERS
DO HOLD^VENPCCQZ(Y)
+7 QUIT
End DoDot:1
+8 IF Z
SET Z=0
SET CNT=CNT+1
+9 IF '$TEST
WRITE !,?5,"All required security keys have been successfully installed"
+10 WRITE !
IF '$$WAIT
GOTO BAIL
HSMP WRITE !,"CHECKING HEALTH SUMMARY MEASUREMENT PANEL: "
+1 SET X="ASQ DEVELOPMENT SCORES"
+2 FOR PCE=1:1:$LENGTH(X,U)
Begin DoDot:1
+3 SET Y=$PIECE(X,U,PCE)
+4 IF '$ORDER(^APCHSMPN("B",Y,0))
WRITE !?10,"The data measurement panel ",Y," is missing!"
SET Z=1
QUIT
+5 WRITE !?10,"Measurement panel: ",Y," <- OK"
QUIT
+6 QUIT
End DoDot:1
MPF ; CONFIRM MEASUREMNT PANEL FIELDS
SET X="5|M^10|L^20|G^30|F^40|P^50|S"
+1 FOR PCE=1:1:6
Begin DoDot:1
+2 SET %=$PIECE(X,U,PCE)
SET Y=+%
SET A="ASQ"_$PIECE(%,"|",2)
+3 SET DA=$ORDER(^APCHSMPN("B","ASQ DEVELOPMENT SCORES",0))
IF 'DA
QUIT
+4 SET %=$NAME(^APCHSMPN(DA,1))
+5 SET DA=$ORDER(^AUTTMSR("B",A,0))
IF 'DA
QUIT
+6 SET $PIECE(@%@(Y,0),U,2)=DA
+7 QUIT
End DoDot:1
+8 IF Z
SET Z=0
SET CNT=CNT+1
+9 IF '$TEST
WRITE !,?5,"All required measurement panels have been successfully installed"
+10 WRITE !
IF '$$WAIT
GOTO BAIL
WCE WRITE !,"CHECKING HEALTH SUMMARY WELL CHILD EXAM COMPONENT: "
+1 SET X="WELL CHILD EXAM"
+2 FOR PCE=1:1:$LENGTH(X,U)
Begin DoDot:1
+3 SET Y=$PIECE(X,U,PCE)
+4 ; IF KIDS FAILS
IF '$ORDER(^APCHSCMP("B",Y,0))
Begin DoDot:2
+5 SET DIC="^APCHSCMP("
SET DIC(0)="L"
SET X="WELL CHILD EXAM"
DO ^DIC
IF Y=-1
QUIT
+6 SET DIE=DIC
SET DA=+Y
SET DR="1////^S X=TAG;2///NO"
SET TAG="WCE;APCHS6B"
+7 LOCK +^APCHSCMP(DA):1
IF $TEST
DO ^DIE
LOCK -^APCHSCMP(DA)
+8 QUIT
End DoDot:2
+9 IF '$ORDER(^APCHSCMP("B",Y,0))
WRITE !?10,"The health summary component ",Y," is missing!"
SET Z=1
QUIT
+10 WRITE !?10,"Health summary component: ",Y," <- OK"
QUIT
+11 QUIT
End DoDot:1
+12 IF Z
SET Z=0
SET CNT=CNT+1
+13 IF '$TEST
WRITE !,?5,"The required components have been successfully installed"
+14 WRITE !
IF '$$WAIT
GOTO BAIL
HS WRITE !,"CHECKING WELL CHILD HEALTH SUMARY TYPE: "
+1 SET Y="WELL CHILD EXAM"
+2 IF '$ORDER(^APCHSCTL("B",Y,0))
WRITE !?10,"The health summary type ",Y," is missing!"
SET CNT=CNT+1
GOTO MCK
+3 WRITE !?10,"Health summary type: ",Y," <- OK"
+4 WRITE !,?5,"The required health summary types have been successfully installed"
HSCMP ; CHECK HS
SET Z=0
DO CMP^VENPCCQZ(.Z)
IF Z
SET Z=0
SET CNT=CNT+1
+1 ; MAKE SURE CORRECT MEASUREMENT PANELS ARE ASSIGNED TO THIS HEALTH SUMMARY TYPE
DO MP^VENPCCQZ
+2 WRITE !
IF '$$WAIT
GOTO BAIL
BOC WRITE !!,"CHECKING BROKER OPTION CONTENT"
+1 SET X="VEN ASQ GET PATIENT ID^VEN ASQ GET DATA^VEN ASQ GET VISITS^VEN ASQ START TX^VEN ASQ FLUSH^BMX ADO SS"
+2 SET X=X_U_"VEN KB EDIT PTED^VEN KB EDIT DEV^VEN KB EDIT AUT^VEN KB EDIT EXAM"
+3 SET IEN=$ORDER(^DIC(19,"B","VEN RPC",0))
IF 'IEN
WRITE !,"The broker option VEN RPC is missing"
GOTO HSMP
+4 FOR PCE=1:1:$LENGTH(X,U)
Begin DoDot:1
+5 SET Y=$PIECE(X,U,PCE)
+6 SET %=$ORDER(^XWB(8994,"B",Y,0))
+7 IF '%
WRITE !?10,"RPC '",Y,"' has not been assigned to broker option VEN RPC"
SET Z=1
QUIT
+8 QUIT
End DoDot:1
+9 IF Z
SET Z=0
SET CNT=CNT+1
+10 IF '$TEST
WRITE !,"All required RPCs have been assigned to broker option VEN RPC"
+11 WRITE !
IF '$$WAIT
GOTO BAIL
MCK ; ASSIGN BROKER OPTIONS TO EXISTING MENUS
DO MENU^VENPCCQZ
+1 ; ASSIGN THE BROKER OPTION TO INDIVIDUAL USERS AS A SECONDARY MENU
DO SMENU^VENPCCQZ
+2 WRITE !
IF '$$WAIT
GOTO BAIL
+3 DO ACT
+4 DO OCX
FIN DO ^XBFMK
+1 IF 'CNT
WRITE !!,"All required RPMS components are present and accounted for!"
QUIT
+2 WRITE !!?20,"**** WARNING ****",!!,"One or more critical RPMS components is missing from the Well Child Module"
+3 WRITE !,"You may need to reinstall the system. Please check with the OIT help desk"
+4 QUIT
+5 ;
OCX ; EP - REGISTER FORM IN THE OCX COMPONENT FILE - REQUIRED FOR ALL VERSIONS OF MEASUREMENT PLOTTING
+1 NEW DIC,DLAYGO,DA,X,Y
+2 SET X=$ORDER(^VEN(7.41,"B","WELL CHILD EXAM (NATL)",0))
IF 'X
QUIT
+3 SET DA(1)=$ORDER(^VEN(7.62,"B","PEDS GROWTH CHART",0))
IF 'DA(1)
QUIT
+4 SET DIC="^VEN(7.62,"_DA(1)_",6,"
SET DIC(0)="L"
+5 SET (DLAYGO,DIC("P"))=19707.626
SET X="`"_X
+6 DO ^DIC
+7 QUIT
+8 ;
+1 DO MENU^VENPCCQZ
+2 QUIT
+3 ;
CONVERT ; EP - CONVERT OLD WELL CHILD FORMS
+1 WRITE !!,"Checking all of your well child templates to see if they use",!,"the new knowledgebase format..."
+2 NEW TIEN,X,Y,Z,%,DIC,DIE,DA,DR,CIEN,DOM,DIEN,TMPL
+3 SET TIEN=0
SET CIEN=$ORDER(^VEN(7.11,"B","WELL CHILD NUTRITION",0))
+4 FOR
SET TIEN=$ORDER(^VEN(7.41,TIEN))
IF 'TIEN
QUIT
IF '$ORDER(^VEN(7.41,TIEN,19,0))
IF $DATA(^VEN(7.41,TIEN,16,"B",CIEN))
Begin DoDot:1
+5 SET TMPL=$PIECE($GET(^VEN(7.41,TIEN,0)),U)
IF '$LENGTH(TMPL)
QUIT
+6 WRITE !?5,"OK to convert ",TMPL," to new format"
+7 SET %=1
DO YN^DICN
+8 IF %'=1
QUIT
+9 SET DA(1)=TIEN
SET DIC="^VEN(7.41,"_DA(1)_",19,"
+10 SET DIC("P")=$PIECE(^DD(19707.41,19,0),U,2)
SET DLAYGO=+DIC("P")
SET DIC(0)="L"
+11 SET DOM="WELL CHILD NATL"
+12 FOR
SET DOM=$ORDER(^VEN(7.13,"B",DOM))
IF DOM'["WELL CHILD NATL"
QUIT
Begin DoDot:2
+13 SET DIEN=$ORDER(^VEN(7.13,"B",DOM,0))
IF 'DIEN
QUIT
+14 SET X="`"_DIEN
+15 DO ^DIC
IF Y=-1
QUIT
+16 SET %=$SELECT(DOM[" DEV ":10,DOM[" AG ":20,DOM[" NUTR ":30,DOM[" EXAM ":40,1:"")
+17 ; ORDER
IF %
SET $PIECE(^VEN(7.41,TIEN,19,+Y,0),U,2)=%
+18 QUIT
End DoDot:2
+19 WRITE " <- OK"
+20 QUIT
End DoDot:1
+21 DO ^XBFMK
+22 QUIT
+23 ;
ACT ; EP - ACTIVATE A DOMAIN
+1 DO ACT^VENPCCQZ
+2 QUIT
+3 ;
ACTL ; EP - SHOW IF DOMAIN IS ACTIVE
+1 SET DIEN=0
SET TOT=0
+2 FOR
SET DIEN=$ORDER(^VEN(7.13,DIEN))
IF 'DIEN
QUIT
Begin DoDot:1
+3 SET X=$GET(^VEN(7.13,DIEN,0))
+4 SET Y=$PIECE(X,U)
IF Y'["WELL CHILD"
QUIT
+5 SET Z=$PIECE(X,U,7)
SET TOT=TOT+1
SET TOT(TOT)=DIEN
+6 WRITE !?5,TOT,". ",Y," <-",$SELECT(Z'=1:"IN",1:""),"ACTIVE"
+7 QUIT
End DoDot:1
+8 QUIT
+9 ;
BAIL ; EP - ABORT THE SESSION
+1 WRITE !!,"Comprehensive check of the well baby module has been prematurely terminated!"
+2 WRITE !,"Please try again later..."
+3 QUIT
+4 ;
WAIT() ; EP-WAIT STATE
+1 NEW %
+2 WRITE "<>"
W1 READ %:$GET(DTIME,300)
IF '$TEST
QUIT 0
+1 WRITE $CHAR(13),?79,$CHAR(13)
+2 IF %?1."^"
QUIT 0
+3 IF %?1."?"
WRITE "Press the <ENTER> key to keep scrolling or '^' to quit <>"
GOTO W1
+4 QUIT 1
+5 ;
BRK ; EP - START/STOP THE BROKER
+1 NEW %,%Y
+2 ; START THE BROKER
WRITE !!,"Want to start the WCM broker now"
+3 SET %=1
+4 DO YN^DICN
IF %'=1
QUIT
+5 DO STRT^BMXMON(10501)
BRK1 ; STOP THE BROKER
+1 ; STOP THE BROKER
WRITE !!,"The broker is currently running. Want to stop it"
+2 SET %=1
+3 DO YN^DICN
IF %'=1
QUIT
+4 DO STOP^BMXMON
+5 QUIT
+6 ;
CIA(DA,OUT) ; EP - SCREEN CIA OBJECTS FOR KIDS BUILD
+1 SET OUT=""
+2 IF $DATA(DA)
+3 IF '$TEST
QUIT
+4 NEW X,Y,Z,%
+5 SET X=$PIECE($GET(^CIAVOBJ(19930.2,DA,0)),U)
IF X=""
QUIT
+6 SET Y=$EXTRACT(X,1,8)
+7 IF Y="FILE:BMX"
SET OUT=1
QUIT
+8 IF Y="FILE:IND"
SET OUT=1
QUIT
+9 IF Y="FILE:INF"
SET OUT=1
QUIT
+10 IF Y="FILE:ITE"
SET OUT=1
QUIT
+11 IF Y="IHS.WCM."
SET OUT=1
QUIT
+12 QUIT
+13 ;