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

VENPCCQX.m

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