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

VENPCCQZ.m

Go to the documentation of this file. 
  1. VENPCCQZ ; IHS/OIT/GIS - POST INSTALL & APPLICATION CONFIG OPTION ; [ 03/31/09   5:36 PM ]
  1.  ;;2.6;PCC+;**1,3**;MAR 23, 2011
  1.  ;
  1.  ;
  1.  ;
  1. VPTED ; EP - UPDATE V PATIENT ED FILE
  1.  N X,Y,Z
  1.  I $L($T(^VENLINIT)) D
  1.  . W !,"It looks like you need to update the V PATIENT ED file..."
  1.  . W !,"When asked if you want to overwrite security codes, answer 'YES'"
  1.  . W !,"When asked if everything is OK, answer 'YES'",!!
  1.  . D ^VENLINIT
  1.  . W !
  1.  . Q
  1.  Q
  1.  ; 
  1. VWC ; EP - UPDATE V WELL CHILD FILE"
  1.  N X,Y,Z
  1.  I $L($T(^VENLINIT)) D
  1.  . W !,"It looks like you need to install the V WELL CHILD file..."
  1.  . W !,"When asked if you want to overwrite security codes, answer 'YES'"
  1.  . W !,"When asked if everything is OK, answer 'YES'"
  1.  . D ^VENMINIT
  1.  . W !
  1.  . Q
  1.  Q
  1.  ; 
  1. MP ; EP - SET MEASUREMENT PANELS CORRECTLY
  1.  N TIEN,X,Y,Z,%,DA,DIC,DIE,DIK,MP,PS,PSM,ASQ,PIEN
  1.  S TIEN=$O(^APCHSCTL("B","WELL CHILD EXAM",0)) I 'TIEN Q
  1.  S PS=$O(^APCHSMPN("B","PEDIATRIC STD",0))
  1.  S PSM=$O(^APCHSMPN("B","PEDIATRIC STD METRIC",0))
  1.  S ASQ=$O(^APCHSMPN("B","ASQ DEVELOPMENT SCORES",0))
  1.  S PIEN=0,Z=""
  1.  F  S PIEN=$O(^APCHSCTL(TIEN,3,PIEN)) Q:'PIEN  D
  1.  . S X=$G(^APCHSCTL(TIEN,3,PIEN,0)) I '$L(X) Q
  1.  . S Y=$P(X,U,2)
  1.  . I Y=PS S Z=Z_"PS^" Q
  1.  . I Y=PSM S Z=Z_"PSM^" Q
  1.  . I Y=ASQ S Z=Z_"ASQ" Q
  1.  . ; KILL OF BAD PANEL
  1.  . S DA(1)=TIEN,DIK="^APCHSCTL("_DA(1)_",3,",DA=PIEN
  1.  . D ^DIK
  1.  . Q
  1.  S DA(1)=TIEN,DIC="^APCHSCTL("_DA(1)_",3,"
  1.  S DIC(0)="L",DIC("P")=$P(^DD(9001015,4,0),U,2),DLAYGO=9001015.02
  1.  I Z'["PS" D
  1.  . S X=$O(^APCHSCTL(TIEN,3,9999),-1)+1
  1.  . D ^DIC I Y=-1 Q
  1.  . S $P(^APCHSCTL(TIEN,3,+Y,0),U,2)=PS
  1.  . Q
  1.  I Z'["ASQ" D
  1.  . S X=$O(^APCHSCTL(TIEN,3,9999),-1)+1
  1.  . D ^DIC I Y=-1 Q
  1.  . S $P(^APCHSCTL(TIEN,3,+Y,0),U,2)=ASQ
  1.  . Q
  1.  W !?5,"The correct measurement panels have been assigned to this component"
  1.  D ^XBFMK
  1.  Q
  1.  ; 
  1. CMP(Z) ; EP - CHECK COMPONENTS OF WELL CHILD EXAM HEALTH SUMMARY
  1.  N WIEN,MIEN,DIEN,TIEN,CIEN,X,Y,%
  1.  S Z=0
  1.  S TIEN=$O(^APCHSCTL("B","WELL CHILD EXAM",0)) I 'TIEN Q
  1.  S WIEN=$O(^APCHSCMP("B","WELL CHILD EXAM",0))
  1.  S MIEN=$O(^APCHSCMP("B","MEASUREMENT PANELS",0))
  1.  S DIEN=$O(^APCHSCMP("B","DEMOGRAPHIC DATA",0))
  1.  S %=$NA(^APCHSCTL(TIEN,1)),Z=$P($G(@%@(30,0)),U,2) I Z,Z'=WIEN,'$D(@%@("B",31)) D
  1.  . K @%@(30,0) S @%@(31,0)=31_U_WIEN
  1.  . K @%@("B",30) S @%@("B",31,31)=""
  1.  . K @%@("C",Z) S @%@("C",WIEN,31)=""
  1.  . Q
  1.  S Y="",CIEN=0,Z=0
  1.  F  S CIEN=$O(^APCHSCTL(TIEN,1,CIEN)) Q:'CIEN  D
  1.  . S %=+$P($G(^APCHSCTL(TIEN,1,CIEN,0)),U,2)
  1.  . I %=WIEN S Y=Y_"WCE^" Q
  1.  . I %=MIEN S Y=Y_"MP^" Q
  1.  . I %=DIEN S Y=Y_"DP^"
  1.  . Q
  1.  I Y'["WCE" W !?5,"The WELL CHILD EXAM component is missing" S Z=1 Q
  1.  I Y'["MP" W !?5,"The MEASUREMENT PANEL component is missing" S Z=1 Q
  1.  I Y'["DP" W !?5,"The DEMOGRAPHIC component is missing" S Z=1 Q
  1.  W !?5,"All required components are present"
  1.  Q
  1.  ;
  1. SMENU ; EP - ASSIGN BROKER OPTION AS A SECONDARY MENU FOR WCM USERS
  1.  N %,%Y,DIC,DIE,DA,DR,X,Y,Z,DFN,BIEN,VIEN
  1.  S VIEN=$O(^DIC(19,"B","VEN RPC",0)) I 'VIEN Q
  1.  S BIEN=$O(^DIC(19,"B","BMXRPC",0)) I 'BIEN Q
  1.  W !!,"Broker options can also be assigned to specific users who do not use"
  1.  W !,"any of the primary menus listed above."
  1.  W !,"Want to allow these special users to access WCM desktop components"
  1.  S %=2 D YN^DICN I %'=1 Q
  1.  S DIC("A")="Enter the name of a user that needs access privileges: "
  1. SMORE S DIC=200,DIC(0)="AEQM"
  1.  D ^DIC I Y=-1 D ^XBFMK Q
  1.  S DFN=+Y
  1.  I $D(^VA(200,DFN,203,"B",VIEN)),$D(^VA(200,DFN,203,"B",BIEN)) W !,"This user already has access" G SMORE
  1.  W !,"Are you sure you want to allow access for this user"
  1.  S %=1 D YN^DICN I %'=1 G SMLOOP
  1.  S DA(1)=DFN,DIC="^VA(200,"_DA(1)_",203,",(DLAYGO,DIC("P"))=200.03,DIC(0)="L"
  1.  F X=("`"_VIEN),("`"_BIEN) D ^DIC
  1.  K DIC
  1.  I Y=-1 W "Unable to assign access privileges to this user!!!"
  1.  E  W !,"OK, secondary menu options have been assigned to provide access for this user.",!
  1.  S DIC("A")="Enter another user that needs access privileges: "
  1. SMLOOP G SMORE
  1.  ; 
  1. HOLD(KEY) ; EP - SECURITY KEY HOLDERS
  1.  N DFN,NAME,%,Y,PRIV,KIEN,Z
  1.  S PRIV=0,KIEN=$O(^DIC(19.1,"B",KEY,0)) I 'KIEN Q
  1.  I DUZ(0)="@"!$D(^VA(200,DUZ,52,KIEN,0))!$D(^XUSEC("XUMGR",DUZ)) S PRIV=1 ; USER HAS KEY ALLOCATION PRIVELEGES
  1.  I $O(^XUSEC(KEY,0)) D  G:PRIV HOLD1 Q
  1.  . S DFN=0 W !?15,"Holders:"
  1.  . F  S DFN=$O(^XUSEC(KEY,DFN)) Q:'DFN  S NAME=$P($G(^VA(200,DFN,0)),U) I $L(NAME) W !?20,NAME
  1.  . Q
  1.  W !?15,"Currently no users hold this key!"
  1.  I 'PRIV Q
  1.  W !?15,"Want to assign it to yourself"
  1.  S %=1 D YN^DICN
  1.  I %=1 S Y=$$ADDKEY(DUZ,KIEN,1)
  1. HOLD1 W !!?2,"Want to assign ",KEY," to any other IT personnel or supervisors"
  1.  S %=2 D YN^DICN
  1.  I %'=1 Q
  1.  S Y=$$ADDKEY(DUZ,KIEN) I Y=-1 Q
  1.  G HOLD1 ; GET ANOTHER KEYHOLDER
  1.  ; 
  1. ADDKEY(USER,KIEN,SELF) ; EP - ALLOCATE A KEY TO A USER
  1.  N DIC,X,Y,%,DA,DR,DIE,TODAY,SCIEN
  1.  I $G(SELF) S Y=DUZ G AK1
  1.  S DIC=200,DIC(0)="AEQM",DIC("A")="Allocate this key to: "
  1.  D ^DIC I Y=-1 Q Y
  1.  S SCIEN=$O(^VA(200,+Y,51,"B",KIEN,0)) I SCIEN D  Q 1 ; THIS USER ALREADY HAS THE KEY
  1.  . W !,"This user already holds this key!",!,"Want to de-allocate the key"
  1.  . S %=2 D YN^DICN I %'=1 D ^XBFMK Q
  1.  . S DA(1)=+Y,DA=SCIEN,DIK="^VA(200,"_DA(1)_",51,"
  1.  . D ^DIK,^XBFMK W " (Key de-allocated)"
  1.  . Q
  1. AK1 S DA(1)=+Y,DIC="^VA(200,"_DA(1)_",51,",DIC("P")="200.051PA",DIC(0)="L",DLAYGO=200.051
  1.  S X="`"_KIEN
  1.  D ^DIC I Y=-1 Q Y
  1.  S DIE=DIC,DR=".02////^S X=USER;.03////^S X=TODAY"
  1.  L +^VA(200,DA(1)):1 I  D ^DIE L -^VA(200,DA(1))
  1.  W " <- Allocated"
  1.  D ^XBFMK
  1.  Q 1
  1.  ; 
  1.  N BIEN,Y,TOT,Z,MIEN,X,%,DIC,DIE,DA,DR,%Y,XIEN
  1.  W !!,"CHECKING BROKER OPTION LINKS"
  1.  W !,"In order to access the WCM desktop components, certain broker options must"
  1.  W !,"be linked to the PRIMARY MENU of clinic nurses and doctors who use the WCM."
  1.  W !,"(One moment please...) "
  1.  S BIEN=$O(^DIC(19,"B","VEN RPC",0)) I 'BIEN Q
  1.  S XIEN=$O(^DIC(19,"B","BMXRPC",0)) I 'XIEN Q
  1.  S Y=0 K TOT S TOT=0
  1.  F  S Y=$O(^DIC(19,Y)) Q:'Y  I $D(^DIC(19,Y,10,"B",BIEN)) S TOT=TOT+1,TOT(TOT)=Y
  1.  I '$D(TOT) W !,"The broker option 'VEN RPC' has not been linked to any user menu!" G MENU1
  1.  W !!,"The broker option 'VEN RPC' is assigned to the following menu(s):"
  1.  S TOT=0 F  S TOT=$O(TOT(TOT)) Q:'TOT  S Y=$G(TOT(TOT)) I Y D
  1.  . S Z=$P($G(^DIC(19,Y,0)),U) I '$L(Z) Q
  1.  . W !?5,TOT,". ",Z
  1.  . Q
  1.  I '$D(TOT(1)) W "  NONE!",!,"Want to assign VEN RPC to a menu"
  1.  E  W !,"Want to make any changes to the 'VEN RPC' assignments"
  1.  S %=2 D YN^DICN I %'=1 Q
  1.  S DIC("A")="Enter the name of a host menu: "
  1.  W !! D ^DIC I Y=-1 Q
  1.  S MIEN=+Y
  1.  I $P($G(^DIC(19,MIEN,0)),U,4)'="M" D  G MENU1 ; OPTION TYPE MUST BE 'MENU'
  1.  . W !,"VEN RPC must be associated with a menu option"
  1.  . W !,$P(Y,U,2)," is not a menu option.  Try again"
  1.  . Q
  1.  I $D(^DIC(19,MIEN,10,"B",BIEN)) D  G MENU1 ; VEN RPC IS ALREADY ASSOCIATED WITH THIS MENU
  1.  . W !,"VEN RPC is already associated with this option."
  1.  . W !,"Want to remove VEN RPC from this menu"
  1.  . S %=2 D YN^DICN I %'=1 Q
  1.  . S (D0,DA(1))=MIEN,DIK="^DIC(19,"_DA(1)_",10,",DA=$O(^DIC(19,MIEN,10,"B",BIEN,0))
  1.  . I DA D ^DIK W !,"VEN RPC has been removed from this menu"
  1.  . Q
  1.  S X=$O(^DIC(19,MIEN,10,0))+1,Y=$G(^DIC(19,MIEN,10,0)),Z=$NA(^DIC(19,MIEN,10))
  1.  I '$L(Y) S @Z@(0)="^19.01PI^1^1"
  1.  E  S %=$P(@Z@(0),U,3)+1,@Z@(0)="^19.01^"_%_U_%
  1.  S @Z@(X,0)=BIEN_"^RPC",@Z@("B",BIEN,X)=""
  1.  W !,"VEN RPC is now associated with this option"
  1.  I $D(@Z@("B",XIEN)) G MENU1
  1.  S %=$P(@Z@(0),U,3)+1,@Z@(0)="^19.01^"_%_U_%
  1.  S X=$O(^DIC(19,MIEN,10,0))+1
  1.  S @Z@(X,0)=XIEN_"^RPC",@Z@("B",XIEN,X)="" ; ALSO ADD BMXRPC
  1.  G MENU1
  1.  ; 
  1. DINFO ; EP - CHECK/FIX KB DOMAIN POINTERS
  1.  N MNIEN,DIEN,STG,X,Y,%,TYPE,NAME,GBL,TXT
  1.  S MNIEN=$O(^APCDTKW("B","OCM",0)) I 'MNIEN Q
  1.  S GBL=$NA(^VEN(7.13)),(NAME,TXT)="OB NATL"
  1.  F  S NAME=$O(@GBL@("B",NAME)) Q:NAME'[TXT  D
  1.  . S DIEN=$O(@GBL@("B",NAME,0))
  1.  . I '$D(@GBL@(DIEN,0)) Q
  1.  . S $P(@GBL@(DIEN,0),U,3)=MNIEN
  1.  . S $P(@GBL@(DIEN,0),U,4)=$S(NAME[" PP AG ":"OBAG",NAME[" PP EXAM ":"OBEX",NAME[" NATL EXAM ":"OBEX",NAME[" NATL AG ":"OBAG",1:"")
  1.  . Q
  1.  W !?10,"Knowledgebase domain definitions have been verified"
  1.  Q
  1.  ; 
  1. ACT ; EP - MANAGE WCM DOMIANS: MAKE THEM ACTIVE OR INCATIVE
  1.  N %,%Y,DIR,DIC,DIE,DA,DR,X,Y,Z,%,DIEN,TOT
  1.  W !!,"Checking Knowledgebase domains... ",!
  1.  K TOT D ACTL
  1.  S %=2 W !!,"Want to change the status of any of these elements"
  1.  D YN^DICN I %'=1 Q
  1.  S DIR("A")="Which element"
  1. ACT1 S DIR(0)="NO^1:"_TOT_":0"
  1.  D ^DIR I 'Y Q
  1.  S DA=$G(TOT(Y)) I 'DA Q
  1.  S DIE="^VEN(7.13,",DR=".07Is this domain active?"
  1.  L +^VEN(7.13,DA):1 I  D ^DIE L -^VEN(7.13,DA)
  1.  D ACTL
  1.  S DIR("A")="Another element" W !! G ACT1
  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. XRT ; EP - MAKE SURE EXTERNAL ROUTINES ARE PRESENT
  1.  Q
  1.  W !!,"CHECKING REQUIRED ROUTINES OUTSIDE OF THE WCM PACKAGE..."
  1.  I '$L($T(WCE^APCHS6B)) W !?5,"The routine APCHS6B is missing!"
  1.  E  W !?5,"^APCHS6B",?15,"<- OK"
  1.  I '$L($T(DATA^VENPCCQB)) W !?5,"The routine VENPCCQB is missing!"
  1.  E  W !?5,"^VENPCCQB",?15,"<- OK"
  1.  I '$L($T(VWC^VENPCCQC)) W !?5,"The routine VENPCCQB is missing!"
  1.  E  W !?5,"^VENPCCQB",?15,"<- OK"
  1.  I '$L($T(EXAM^VENPCCQD)) W !?5,"The routine VENPCCQD is missing!"
  1.  E  W !?5,"^VENPCCQD",?15,"<- OK"
  1.  I '$L($T(SS^BMXADO)) W !?5,"The Broker routines (BMX*) are missing!"
  1.  E  W !?5,"The Broker routines (BMX*) are loaded"
  1.  Q
  1.  ;