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

VENPCCK1.m

Go to the documentation of this file. 
  1. VENPCCK1 ; IHS/OIT/GIS - KNOWLEDGE BASE ;
  1.  ;;2.6;PCC+;;NOV 12, 2007
  1.  ; RPMS DIALOGUE
  1.  ;
  1.  ;
  1. AGE ; EP - DIALOGUE FOR AGE-SEX SPECIFIC ITEMS
  1.  N AGE
  1.  S AGE=1
  1.  D CAT
  1.  Q
  1.  ;
  1. CAT ; EP - GET THE KB CATEGORY
  1.  N DIC,X,Y,Z,%,CIEN,IIEN,DIR,DA,DIK,%Y
  1.  S DIC("A")="Enter the name of the knowledgebase category: "
  1.  S DIC="^VEN(7.11,",DIC(0)="AEQML",DLAYGO=19707.11
  1.  D ^DIC I Y=-1 D ^XBFMK Q
  1.  S CIEN=+Y
  1.  I $P(Y,U,3) D ITEM(CIEN) Q
  1. M1 W !!,"What do you want to do next ->"
  1.  W !,?3,"1. Add or edit items in this category."
  1.  W !,?3,"2. Delete this KB category."
  1.  W !,?3,"3. Quit."
  1.  S DIR(0)="N^1:3:0",DIR("A")="Your choice",DIR("B")="1" D ^DIR
  1.  I Y=1 D ITEM(CIEN) Q
  1.  I Y=3!('Y) D ^XBFMK Q
  1.  I Y=2 W !!,"This will DELETE the category and all items associated with it!!!"
  1.  W !,"Are you sure you want to do this"
  1.  S %=2 D YN^DICN
  1.  I %'=1 W ! G M1
  1.  S DIK="^VEN(7.11,",DA=CIEN D ^DIK
  1.  S DA=0,DIK="^VEN(7.12,"
  1.  F  S DA=$O(^VEN(7.12,"B",CIEN,DA)) Q:'DA  D ^DIK ; CLEAN OUT THE ASSOCIATED ITEMS
  1.  W !,"  *** CATEGORY DELETED  ***"
  1.  D ^XBFMK
  1.  Q
  1.  ;
  1. ITEM(CIEN) ; EP - ENTER/EDIT ITEMS FOR A SPECIFIC CATEGORY
  1.  N DIC,DIK,DIR,DA,X,Y,Z,%,TUNIT,FLAG
  1.  I AGE S TUNIT=" "_$P($G(^VEN(7.11,CIEN,0)),U,10)
  1. LOOP W !!,"What do you want to do next ->"
  1.  W !,?3,"1. Add an item"
  1.  W !,?3,"2. Edit an existing item"
  1.  W !,?3,"3. Delete an item"
  1.  W !,?3,"4. Quit"
  1.  S DIR(0)="N^1:4:0",DIR("A")="Your choice",DIR("B")="1" D ^DIR
  1.  I Y=4!('Y) D ^XBFMK Q  ; QUIT
  1.  I Y=2 S FLAG="EDIT"
  1.  I Y=3 S FLAG="DELETE"
  1.  I Y=1 S FLAG="ADD" S IIEN=$$ADD(CIEN) G:'IIEN LOOP D EDIT(IIEN) G LOOP ; KEEP LOOPING
  1.  ; 
  1. LOOKUP S DIC="^VEN(7.12,",DIC(0)="AEQM"
  1.  S DIC("A")="Item: "
  1.  S DIC("S")="I +^(0)=CIEN"
  1.  S %="W "": "",$P($G(^VEN(7.12,Y,0)),U,2)"
  1.  I AGE S %=%_","" (Age: "",$P($G(^VEN(7.12,Y,0)),U,13),""-"",$P($G(^VEN(7.12,Y,0)),U,14),$G(TUNIT),"")"""
  1.  S DIC("W")=%
  1.  D ^DIC I Y=-1 D ^XBFMK G LOOP
  1.  K DIC S IIEN=+Y
  1.  I FLAG="EDIT" D EDIT G LOOP
  1. DELETE W !,"Are you sure you want to delete the item"
  1.  S %=2 D YN^DICN
  1.  I %'=1 W ! G M1
  1.  S DIK="^VEN(7.12,",DA=IIEN D ^DIK
  1.  W !,"  *** ITEM DELETED ***",!
  1.  G LOOP
  1.  ;
  1. EDIT(DA) ; EP - EDIT AN ITEM
  1.  N DIE,DR,X,Y,Z,%
  1.  S DIE="^VEN(7.12,"
  1.  S DR=""
  1.  I AGE D
  1.  . S DR=".02Item name"
  1.  . D ^DIE
  1.  . I '$L($P($G(^VEN(7.12,DA,0)),U,2)) Q  ; REQUIRED FIELD
  1.  . S DR=".04Code;.1Gender screen;.13Starting age (mos);.14Ending age (mos)"
  1.  . D ^DIE
  1.  . Q
  1.  I $D(^VEN(7.12,DA,0)),'$L($P($G(^(0)),U,2)) S DIK="^VEN(7.12," D ^DIK ; REQUIRED FIELD
  1.  D ^XBFMK
  1.  Q
  1.  ;
  1. ADD(CIEN) ; EP - ADD A NEW ITEM
  1.  N DIC,X,Y,%
  1.  S DIC="^VEN(7.12,",DIC(0)="L",DLAYGO=19707.12
  1.  S X="""`"_CIEN_""""
  1.  D ^DIC
  1.  I Y=-1 Q ""
  1.  Q +Y
  1.  ;
  1.  ;
  1.  ; --------------------------------------------------------
  1.  ;
  1. TADD(OUT,IN) ; EP - ADD A KB TO ONE OR MORE TEMPLATES
  1.  S OUT="UPDATE FAILED!"
  1.  S IN=$G(IN) I '$L(IN) Q
  1.  N KIEN,TSTG,TIEN,DIC,DA,X,Y,%,PCE,LEN
  1.  S KIEN=+IN I '$D(^VEN(7.11,KIEN,0)) Q
  1.  S DIC(0)="L",DLAYGO=19707.4116
  1.  S DIC("P")="19707.4116P"
  1.  S X="`"_KIEN
  1.  S TSTG=$P(IN,";",2) S LEN=$L(TSTG,",")
  1.  F PCE=1:1:LEN D
  1.  . S DA(1)=$P(TSTG,",",PCE)
  1.  . I '$D(^VEN(7.41,DA(1),0)) Q
  1.  . S DIC="^VEN(7.41,"_DA(1)_",16,"
  1.  . D ^DIC I Y=-1 Q
  1.  . Q
  1.  D ^XBFMK
  1.  S OUT="TEMPLATE FILE(S) UPDATED SUCCESSFULLY!"
  1.  Q
  1.  ; 
  1. TREM(OUT,IN) ; EP - REMOVE A KB FROM ONE OR MORE TEMPLATES
  1.  S OUT="UNABLE TO REMOVE KB FROM TEMPLATE(S)!"
  1.  S IN=$G(IN) I '$L(IN) Q
  1.  N KIEN,TSTG,TIEN,DIK,DA,X,Y,%,PCE,LEN
  1.  S KIEN=+IN I '$D(^VEN(7.11,KIEN,0)) Q
  1.  S TSTG=$P(IN,";",2) S LEN=$L(TSTG,",")
  1.  F PCE=1:1:LEN D
  1.  . S DA(1)=$P(TSTG,",",PCE)
  1.  . I '$D(^VEN(7.41,DA(1),0)) Q
  1.  . S DIK="^VEN(7.41,"_DA(1)_",16,"
  1.  . S DA=$O(^VEN(7.41,DA(1),16,"B",KIEN,0)) I 'DA Q
  1.  . D ^DIK I Y=-1 Q
  1.  . Q
  1.  D ^XBFMK
  1.  S OUT="KB REMOVED SUCCESSFULLY!"
  1.  Q
  1.  ;
  1.  ; --------------------------------------------------------
  1.  ;
  1. KBG(OUT,IN) ; EP - RPC: VEN PCC+ GET KB GROUPS
  1.  S OUT="BMX ADO SS^VEN KB CATEGORY^^B~~~999999"
  1.  Q
  1.  ; 
  1. KBI(OUT,IN) ; EP-SUBMIT KB GROUP AND RETURN ALL THE ITEMS IN A TABLE
  1.  S OUT=""
  1.  I '$L(IN) Q
  1.  N DIC,X,KGIEN,KIEN,DA
  1.  S KGIEN=$O(^VEN(7.11,"B",IN,0))
  1.  I 'KGIEN D  ; NEED TO ADD NEW GROUP
  1.  . S DIC="^VEN(7.11,",DOC(0)="L"
  1.  . S DLAYGO=19707.11 S X=IN
  1.  . D ^DIC I Y=-1 Q
  1.  . S KGIEN=+Y
  1.  . Q
  1.  D ^XBFMK
  1.  I 'KGIEN Q
  1.  S OUT="BMX ADO SS^VEN KB ITEM^^B~"_KGIEN_"~"_KGIEN_"~999999"
  1.  Q
  1.  ; 
  1. TAX(OUT,IN) ; EP - RPC: VEN PCC+ KB TAXONOMY
  1.  S OUT="BMX ADO SS^VEN KB TAXONOMY^^~~~~~ITAX~VENPCCK~"  ; RETURN ALL TAXONOMIES
  1.  Q
  1.  ;
  1. KBT1(OUT,IN) ; EP - RPC: VEN PCC+ GET KB TEMPLATES
  1.  I $G(IN)="" S OUT="" Q  ; INVALID KB GROUP
  1.  S OUT="BMX ADO SS^VEN KB TEMPLATES^^~~~~~FKBT~VENPCCK~"_IN  ; RETURN ALL TEMPLATES ASSOC W KB GRP
  1.  Q
  1.  ; 
  1. KBT2(OUT,IN) ; EP - RPC: VEN PCC+ GET NON KB TEMPLATES
  1.  I $G(IN)="" S OUT="" Q  ; INVALID KB GROUP
  1.  S OUT="BMX ADO SS^VEN KB TEMPLATES^^~~~~~NKBT~VENPCCK~"_IN  ; RETURN ALL TEMPLATES NOT ASSOC W KB GRP
  1.  Q
  1.  ; 
  1.  ; ------------------------------------------------------------------
  1.  ; 
  1. ITAX(PARAM,IENS,MAX,OUT,TOT) ; EP - RETURN A LIST OF TEMPLATES ASSOCIATED WITH A KB GROUP
  1.  N NAME,DA,STG
  1.  S NAME=""
  1.  F  S NAME=$O(^ATXAX("B",NAME)) Q:NAME=""  D
  1.  . S DA=0
  1.  . F  S DA=$O(^ATXAX("B",NAME,DA)) Q:'DA  D
  1.  .. I $P($G(^ATXAX(DA,0)),U,15)'=80 Q  ; MUST BE AN ICD TAXONOMY
  1.  .. X ("D DATA"_$C(94)_"BMXADOV1(IENS,DA)")
  1.  .. Q
  1.  . Q
  1.  Q ""
  1.  ; 
  1. FKBT(KGIEN,IENS,MAX,OUT,TOT) ; EP - RETURN A LIST OF TEMPLATES ASSOCIATED WITH A KB GROUP
  1.  N MODE S MODE=1
  1.  D FKBTX
  1.  Q ""
  1.  ; 
  1. NKBT(KGIEN,IENS,MAX,OUT,TOT) ; EP - RETURN A LIST OF TEMPLATES THAT ARE NOT ASSOCIATED WITH A KB GROUP
  1.  N MODE S MODE=0
  1.  D FKBTX
  1.  Q ""
  1.  ; 
  1. FKBTX ; FILTERS
  1.  N NAME,DA,STG
  1.  I '$D(^VEN(7.11,+$D(KGIEN),0)) Q
  1.  S NAME=""
  1.  F  S NAME=$O(^VEN(7.41,"B",NAME)) Q:NAME=""  D
  1.  . S DA=0
  1.  . F  S DA=$O(^VEN(7.41,"B",NAME,DA)) Q:'DA  D
  1.  .. I MODE,'$O(^VEN(7.41,DA,16,"B",KGIEN,0)) Q  ; FILTER OUT FORM IF IT IS NOT ASSOCIATED WITH THIS KB GROUP
  1.  .. I 'MODE,$O(^VEN(7.41,DA,16,"B",KGIEN,0)) Q  ; FILTER OUT FORM IF IT IS NOT ASSOCIATED WITH THIS KB GROUP
  1.  .. D DATA^BMXADOV1(IENS,DA)
  1.  .. Q
  1.  . Q
  1.  Q
  1.  ;
  1. KBT3(OUT,IN) ; EP-ASSOCIATE KB GROUP WITH TEMPLATES
  1.  N DIC,X,Y,DA,STG,PCE,KB
  1.  S KB=+$G(IN) I '$D(^VEN(7.11,KB,0)) Q ""
  1.  S DIC("P")="19707.4116P" S DIC(0)="L" S DLAYGO=19707.4116
  1.  S STG=$P(IN,";",2)
  1.  F PCE=1:1:$L(STG,",") D
  1.  . S DA(1)=$P(STG,",",PCE)
  1.  . S X="`"_KB
  1.  . I '$D(^VEN(7.41,DA(1))) Q
  1.  . S DIC="^VEN(7.41,"_DA(1)_",16,"
  1.  . D ^DIC
  1.  . Q
  1.  S OUT="OK" D ^XBFMK
  1.  Q
  1.  ;