VENPCCIX ; IHS/OIT/GIS - INSTALLATION TOOLS: ADD A NEW TEMPLATE FOR VER 2.5 EXTENSION OF VENPCCIT ;
;;2.6;PCC+;;NOV 12, 2007
;
;
;
LAB ; EP-DISPLAY CERTAIN LAB RESULTS
W !!,SEP," RECENT LAB RESULTS ",SEP
W !!,"Want to include recent lab test results on the form..."
S %=2
I $O(^VEN(7.41,TIEN,7,0)) S %=1 ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
D YN^DICN
I %Y=U W !!,SEP G HMR^VENPCCIT
I %Y?2."^" G FIN
S DA(1)=TIEN,DIC="^VEN(7.41,"_DA(1)_",7,"
I %=2,$O(^VEN(7.41,DA(1),7,0)),'$$OK("lab tests") G LAB1 ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
I %=2 D G GRAPH
. S DA(1)=TIEN,DIK=DIC,DA=0
. F S DA=$O(^VEN(7.41,DA(1),7,DA)) Q:'DA D ^DIK
. Q
LAB1 S DIC("P")="19707.417PA",DIC(0)="AEQL",DLAYGO=19707.417
S DIC("A")="Enter the name of "_$S($D(^VEN(7.41,TIEN,7)):"another",1:"a")_" lab test result: "
D ^DIC I Y=-1 G GRAPH
S DA=+Y,DIE=DIC
I $P(Y,U,3) G LAB2
W !,"This test already is on the form. Want to delete it"
S %=2
D YN^DICN
I %=1 S DIK=DIC D ^DIK W ! G LAB1
LAB2 S DR=".02CPT Code;.03Printed test name;.08Max number of results allowed;.09Max age of result allowed (mos);.06Point of care test"
L +^VEN(7.41,TIEN):0 I D ^DIE L -^VEN(7.41,TIEN) W !
G LAB1 ; ADD MORE TESTS TO THE FORM
;
GRAPH ; EP - GRAPHS ASSOCIATED WITH THE FORM
W !!,SEP," GRAPHS ",SEP
W !!,"Want to include graphs of measurable results on this form"
S %=2
I $O(^VEN(7.41,TIEN,6,0)) S %=1 ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
D YN^DICN
I %Y=U W !!,SEP G LAB
I %Y?2."^" G FIN
S DA(1)=TIEN,DIC="^VEN(7.41,"_DA(1)_",6,"
I %=2,$O(^VEN(7.41,DA(1),6,0)),'$$OK("graphs") G GRAPH1 ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
I %=2 D G KB
. S DA(1)=TIEN,DIK=DIC,DA=0
. F S DA=$O(^VEN(7.41,DA(1),6,DA)) Q:'DA D ^DIK
. Q
GRAPH1 S DIC("P")="19707.416P",DIC(0)="AEQL",DLAYGO=19707.416
S DIC("A")="Enter the name of "_$S($D(^VEN(7.41,TIEN,6)):"another",1:"a")_" graph: "
D ^DIC I Y=-1 G KB
S DA=+Y,DIE=DIC
I $P(Y,U,3) W ! G GRAPH1
W !,"This graph already is on the form. Want to delete it"
S %=2
D YN^DICN
I %=1 S DIK=DIC D ^DIK
W ! G GRAPH1 ; ADD MORE GRAPHS TO THE FORM
;
KB ; EP - KNOWLEDGEBASE ASSOCIATED WITH THE FORM
W !!,SEP," KNOWLEDGEBASES ",SEP
W !,"A knowledgebase contains custom guidelines or patient education topics."
S %=2
I $O(^VEN(7.41,TIEN,19,0)) S %=1 D
. W !,"This form already contains the following knowledgebase(s): "
. S KIEN=0 F S KIEN=$O(^VEN(7.41,TIEN,19,"B",KIEN)) Q:'KIEN D
.. S KNM=$P($G(^VEN(7.13,KIEN,0)),U)
.. W !?3,KNM
.. Q
. W !!
. Q
W !,"Want to include knowledgebase(s) on this form"
D YN^DICN
I %Y=U W !!,SEP G GRAPH ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
I %Y?2."^" G FIN
S DA(1)=TIEN,DIC="^VEN(7.41,"_DA(1)_",19,"
I %=2,$O(^VEN(7.41,DA(1),19,0)),'$$OK("knowledgebases") G KB1 ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
I %=2 D G GG
. S DA(1)=TIEN,DIK=DIC,DA=0
. F S DA=$O(^VEN(7.41,DA(1),19,DA)) Q:'DA D ^DIK
. Q
KB1 S DIC("P")="19707.4119P",DIC(0)="AEQL",DLAYGO=19707.4119
S DIC("A")="Enter the name of a knowledgebase clinical domain: "
D ^DIC I Y=-1 G GG ; ASSIGN A KB CLINICAL DOMAIN TO THE TEMPLATE
S DA=+Y
I '$P(^VEN(7.41,TIEN,19,DA,0),U,2) S $P(^(0),U,2)=(DA*5)+100 ; AUTOMATICALLY ASSIGN AN ORDER
I $P(Y,U,3) W ! G KB1 ; CHECK TO SEE IF THE KB DOMAINE IS ALREADY ASSIGNED. IF SO, DOES IT NEED OT BE REMOVED
W !,"This knowledgebase already is on the form. Want to delete it"
S %=2
D YN^DICN
I %=1 S DIK=DIC D ^DIK
W ! G KB1 ; ADD MORE GRAPHS TO THE FORM
;
GG ; EP - GROWTH GRIDS FOR WELL CHILD FORM
S GGIEN=$O(^VEN(7.62,"B","PEDS GROWTH CHART",0)),%=2
I 'GGIEN G CL ; THE PEDS GROWTH CHART OCX IS UNAVAILABLE
W !!,SEP," PEDIATRIC GROWTH GRIDS ",SEP
I $D(^VEN(7.62,GGIEN,6,"B",TIEN)) S %=1
W !!,"Want to include Pediatric Growth Grids on the form"
D YN^DICN
I %=1 G GG1
I %Y=U W !! G KB
I %Y?2."^" G FIN
GGD I $D(^VEN(7.62,GGIEN,6,"B",TIEN)),%=2 D G CL ; DELETE GRID FROM FORM
. W !,"Sure you want to remove the Grids from this template"
. S %=2 D YN^DICN
. I %'=1 D ^XBFMK Q
. S DA(1)=GGIEN
. S DIK="^VEN(7.62,"_DA(1)_",6,"
. S DA=$O(^VEN(7.62,GGIEN,6,"B",TIEN,0)) I 'DA Q
. D ^DIK
. D ^XBFMK
. Q
Q ; PATCHED BY GIS/OIT 01/10/06 ; PCC+ 2.5 PATCH 2
;
GG1 ; EP - UPDATE THE OCX COMPONENTS FILE
S DA(1)=GGIEN
S DIC="^VEN(7.62,"_DA(1)_",6," S DIC(0)="L"
S DLAYGO=19707.626
S DIC("P")=19707.626
S X="`"_TIEN
D ^DIC I Y=-1 G CL
W !,"OK, you may now add Pediatric Growth Grids to this template"
W !,"If 'blank' graphs appear on the printed form, you should review"
W !,"section 5 in the PCC+ users guide to learn about the 'blank graph' remedy"
CL ; CHECKLISTS
W !!,SEP," CHECKLISTS ",SEP
W !,"A checklist contains a set of orderable items or clinical tasks"
W !!,"Want to include checklists(s) on this form"
S %=2
I $O(^VEN(7.41,TIEN,17,0)) S %=1 ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
D YN^DICN
I %Y=U G GG
I %Y?2."^" G FIN
S DA(1)=TIEN,DIC="^VEN(7.41,"_DA(1)_",17,"
I %=2,$O(^VEN(7.41,DA(1),17,0)),'$$OK("checklists") G CL1 ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
I %=2 D G HX
. S DA(1)=TIEN,DIK=DIC,DA=0
. F S DA=$O(^VEN(7.41,DA(1),17,DA)) Q:'DA D ^DIK
. S %=$NA(^VEN(7.41,TIEN)),$P(@%@(0),U,17)=0 ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
. Q
CL1 S %=$NA(^VEN(7.41,TIEN)),$P(@%@(0),U,17)=1 ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
S DIC("P")="19707.4117P",DIC(0)="AEQL",DLAYGO=19707.4117
S DIC("A")="Enter the name of "_$S($D(^VEN(7.41,TIEN,17)):"another",1:"a")_" checklist: "
D ^DIC I Y=-1 G HX
S DA=+Y,DIE=DIC
I $P(Y,U,3) W ! G CL1
W !,"This checklist already is on the form. Want to delete it"
S %=2
D YN^DICN
I %=1 S DIK=DIC D ^DIK
W ! G CL1 ; ADD MORE GRAPHS TO THE FORM
;
HX ; EP - PATIENT HX
W !!,SEP," HISTORICAL INFORMATION ",SEP
HX1 W !!,"Want to include personal history items on the form"
S %=2
I $P($G(^VEN(7.41,TIEN,5)),U,9) S %=1
S Z=$G(FLD(5.09)) I $L(Z) S %=$S(Z=1:1,1:2)
D YN^DICN
I %Y=U G CL
I %Y?2."^" G FIN
S FLD(5.09)=$S(%=1:1,1:0)
I %'=1 G HX3
HX2 W !!,"Want to exclude the onset date from the personal history"
S %=2
I $P($G(^VEN(7.41,TIEN,5)),U,10) S %=1
S Z=$G(FLD(5.1)) I $L(Z) S %=$S(Z=1:1,1:2)
D YN^DICN
I %Y=U G HX1
I %Y?2."^" G FIN
S FLD(5.1)=$S(%=1:1,1:0)
HX3 W !!,"Want to include family history items on this form"
S %=2
I $P($G(^VEN(7.41,TIEN,5)),U,8) S %=1
S Z=$G(FLD(5.08)) I $L(Z) S %=$S(Z=1:1,1:2)
D YN^DICN
I %Y=U G HX1
I %Y?2."^" G FIN
S FLD(5.08)=$S(%=1:1,1:0)
HX4 W !!,"Want to include past surgical procedures on this form"
S %=2
I $P($G(^VEN(7.41,TIEN,5)),U,8) S %=1
S Z=$G(FLD(5.04)) I $L(Z) S %=$S(Z=1:1,1:2)
D YN^DICN
I %Y=U G HX3
I %Y?2."^" G FIN
I %'=1 G FIN
S FLD(5.04)=$S(%=1:1,1:0)
HX5 W !!,"Want to include the diagnosis with the procedure"
S %=1
I '$P($G(^VEN(7.41,TIEN,5)),U,8) S %=2
S Z=$G(FLD(5.05)) I $L(Z) S %=$S(Z=1:1,1:2)
D YN^DICN
I %Y=U G HX4
I %Y?2."^" G FIN
S FLD(5.05)=$S(%=1:1,1:0)
HX6 W !!,"Want to include the operating provider with the procedure"
S %=1
I '$P($G(^VEN(7.41,TIEN,5)),U,8) S %=2
S Z=$G(FLD(5.06)) I $L(Z) S %=$S(Z=1:1,1:2)
D YN^DICN
I %Y=U G HX5
I %Y?2."^" G FIN
S FLD(5.06)=$S(%=1:1,1:0)
HX7 W !!,"Want to exclude minor procedures from the list"
S %=2
I $P($G(^VEN(7.41,TIEN,5)),U,8) S %=1
S Z=$G(FLD(5.07)) I $L(Z) S %=$S(Z=1:1,1:2)
D YN^DICN
I %Y=U G HX6
I %Y?2."^" G FIN
S FLD(5.07)=$S(%=1:1,1:0)
HX8 W !!,"Want to display only the last major procedure"
S %=2
I $P($G(^VEN(7.41,TIEN,5)),U,8) S %=1
S Z=$G(FLD(5.11)) I $L(Z) S %=$S(Z=1:1,1:2)
D YN^DICN
I %Y=U G HX7
I %Y?2."^" G FIN
S FLD(5.11)=$S(%=1:1,1:0)
HX9 W !!,"Want to display the ICD code associated with the procedure"
S %=1
I '$P($G(^VEN(7.41,TIEN,5)),U,8) S %=2
D YN^DICN
I %Y=U G HX8
I %Y?2."^" G FIN
S FLD(5.12)=$S(%=1:1,1:0)
HXDIE D DIE^VENPCCIT(TIEN)
W !!,SEP,!!,"CONGRATULATIONS! This template's definition is now complete..."
W !,"Be sure to copy the template '"_TMN_"_template.doc on to BOTH print severs"
W !,"Then check template synchronization with the 'TS' option on the"
W !,"PCC+ Install menu. It is no longer necessary to make a companion file."
W !,"You can edit the properties of '",TNM,"' at any"
W !,"time by running this utility again.",!!,SEP,!!
FIN D ^XBFMK
Q
;
GRADD ; EP - ENTER A NEW GRAPH
N NAME,TYPE,LFILE,MFILE,FILE,MM,MDP,UNIT,X,Y,Z,%,DIC,DA,DR,DIE,DIR,DTOUT,GIEN
GRA1 S DIR(0)="F^3:30",DIR("A")="Name of graph"
D ^DIR K DIR
I $D(DTOUT) G GRAX
I Y?1."^" G GRAX
I Y'?1U2.29UN W " ??" G GRA1
I $D(^VEN(7.63,"B",Y)) W !,"This graph name already exists! Enter another name..." G GRA1
S DIC(0)="L",X=""""_Y_""""
S DIC="^VEN(7.63,",DLAYGO=19707.63
D ^DIC I Y=-1 Q
W !,"This name will also be used as the graph's title",!
S GIEN=+Y,NAME=$P(Y,U,2)
GRA2 S DIR(0)="S^M:MEASUREMENT;L:LAB TEST RESULT",DIR("A")="Data type",DIR("B")=$G(TYPE)
D ^DIR K DIR
I $D(DTOUT) G GRAX
I Y?1."^" G GRAX
S TYPE=Y
GRAM ; GET MEASUREMENT ENTRY
I TYPE="L" G GRAL
I TYPE'="M" G GRAX
S DIC("A")="Enter the associated MEASUREMENT file entry: "
I $D(^AUTTMSR("B",NAME)) S DIC("B")=NAME
I $L($G(MFILE)) S DIC("B")=MFILE
S DIC(0)="AEQM" S DIC="^AUTTMSR("
D ^DIC I Y=-1 G GRAX
S FILE=+Y,MFILE=$P(Y,U,2)
G GRAMM
;
GRAL ; EP - GET LAB RESULT ENTRY
S DIC("A")="Enter the associated LAB file entry: "
I $D(^LAB(60,"B",NAME)) S DIC("B")=NAME
I $L($G(LFILE)) S DIC("B")=LFILE
S DIC(0)="AEQM" S DIC="^LAB(60,"
D ^DIC I Y=-1 G GRAX
S FILE=+Y,LFILE=$P(Y,U,2)
GRAMM ; MAX MONTHS
S DIR(0)="NO^1:300:0",DIR("A")="Enter the max months displayed in this graph"
S DIR("B")=24 I $G(MM) S DIR("B")=MM
D ^DIR K DIR
I $D(DTOUT) G GRAX
I Y=U W ! G GRAM
I Y?2."^" G GRAX
S MM=Y
GRAD ; MAX DATA POINTS
S DIR(0)="NO^1:999:0",DIR("A")="Enter the max # data points displayed in this graph"
S DIR("B")=10 I $G(MDP) S DIR("B")=MDP
D ^DIR K DIR
I $D(DTOUT) G GRAX
I Y=U W ! G GRAMM
I Y?2."^" G GRAX
S MDP=Y
GRAU ; UNITS
S DIR(0)="FO^3:30",DIR("A")="Units represented in this graph"
I $L($G(UNIT)) S DIR("B")=UNIT
D ^DIR K DIR
I $D(DTOUT) G GRAX
I Y=U W ! G GRAD
I Y?2."^" G GRAX
S UNIT=Y
I UNIT="@" S UNIT=""
I $L(UNIT) W !,"The unit '",UNIT,"' will be used as the y-axis label",!
GRAF ; FILE THE RESULTS
S DIE="^VEN(7.63,",DA=GIEN
S DR=".02///^S X=TYPE;.03///^S X=MM;.04///^S X=MDP;.05///^S X=NAME;.08///^S X=UNIT"
I $L($G(MFILE)) S DR=DR_";.11///^S X=FILE"
I $L($G(LFILE)) S DR=DR_";.12///^S X=FILE"
D ^DIE
W !,"This graph has been added to PCC+.",!,"Use the TCU option to attach it to specific PCC+ templates."
GRAX D ^XBFMK
Q
;
GRED ; EP - EDIT A GRAPH'S PROPERTIES
N DIC,DIE,DR,DA,X,Y,%,TYPE
S DIC="^VEN(7.63,",DIC(0)="AEQ",DIC("A")="Which graph do you want to edit: "
D ^DIC I Y=-1 G GREX
S DA=+Y,DIE=DIC,DR=".02" D ^DIE
S TYPE=$P($G(^VEN(7.63,DA,0)),U,2)
I TYPE="" W !,"No data type specified. Graph entry will be deleted!",! N DIK G GRDEL
I TYPE=1 S DR=".11Associated MEASUREMENT file entry"
I TYPE=2 S DR=".12Associated LAB file entry"
S DR=DR_";.03;.04;.08"
D ^DIE W !,"The properties of this graph have been updated...",!
GREX D ^XBFMK
Q
;
GRD ; EP - DELETE A GRAPH
N DIK,DIC,X,Y,NAME,GRIEN,TIEN,GIEN
S DIC("A")="Which graph do you want to delete: "
S DIC="^VEN(7.63,",DIC(0)="AEQ"
D ^DIC I Y=-1 G GRAX
S GRIEN=+Y,NAME=$P(Y,U,2)
W !,"WARNING: This will remove this graph from PCC+ and ",!,"detach it from all PCC+ templates..."
W !,"Are you sure you want to delete this graph"
S %=0 D YN^DICN I %'=1 G GRAX
GRDT ; REMOVE GRAPH FROM INDIVIDUAL TEMPLATES
S TIEN=0
F S TIEN=$O(^VEN(7.41,TIEN)) Q:'TIEN D ; REMOVE GRAPH FROM ALL TEMPLATE DEFINITIONS
. S GIEN=0 F S GIEN=$O(^VEN(7.41,TIEN,6,"B",GRIEN,GIEN)) Q:'GIEN D
.. S DA(1)=TIEN,DA=GIEN
.. S DIK="^VEN(7.41,"_DA(1)_",6,"
.. D ^DIK
.. Q
. Q
K DIK
GRDEL S DIK="^VEN(7.63," S DA=GRIEN ; REMOVE GRAPH DEFINITION
I '$D(^VEN(7.63,+$G(DA))) Q
D ^DIK W !,NAME," deleted..."
D ^XBFMK
Q
;
OK(TXT) ; EP - CONFRIM REMOVAL OF ITEMS
; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
N %,%Y
S TXT=$S($L($G(TXT)):TXT,1:"items")
W !,"This will remove ALL ",TXT," from the form!!!"
W !,"Are you sure you want to do this"
S %=2
D YN^DICN
I %=1 Q 1
Q 0
;
VENPCCIX ; IHS/OIT/GIS - INSTALLATION TOOLS: ADD A NEW TEMPLATE FOR VER 2.5 EXTENSION OF VENPCCIT ;
+1 ;;2.6;PCC+;;NOV 12, 2007
+2 ;
+3 ;
+4 ;
LAB ; EP-DISPLAY CERTAIN LAB RESULTS
+1 WRITE !!,SEP," RECENT LAB RESULTS ",SEP
+2 WRITE !!,"Want to include recent lab test results on the form..."
+3 SET %=2
+4 ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
IF $ORDER(^VEN(7.41,TIEN,7,0))
SET %=1
+5 DO YN^DICN
+6 IF %Y=U
WRITE !!,SEP
GOTO HMR^VENPCCIT
+7 IF %Y?2."^"
GOTO FIN
+8 SET DA(1)=TIEN
SET DIC="^VEN(7.41,"_DA(1)_",7,"
+9 ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
IF %=2
IF $ORDER(^VEN(7.41,DA(1),7,0))
IF '$$OK("lab tests")
GOTO LAB1
+10 IF %=2
Begin DoDot:1
+11 SET DA(1)=TIEN
SET DIK=DIC
SET DA=0
+12 FOR
SET DA=$ORDER(^VEN(7.41,DA(1),7,DA))
IF 'DA
QUIT
DO ^DIK
+13 QUIT
End DoDot:1
GOTO GRAPH
LAB1 SET DIC("P")="19707.417PA"
SET DIC(0)="AEQL"
SET DLAYGO=19707.417
+1 SET DIC("A")="Enter the name of "_$SELECT($DATA(^VEN(7.41,TIEN,7)):"another",1:"a")_" lab test result: "
+2 DO ^DIC
IF Y=-1
GOTO GRAPH
+3 SET DA=+Y
SET DIE=DIC
+4 IF $PIECE(Y,U,3)
GOTO LAB2
+5 WRITE !,"This test already is on the form. Want to delete it"
+6 SET %=2
+7 DO YN^DICN
+8 IF %=1
SET DIK=DIC
DO ^DIK
WRITE !
GOTO LAB1
LAB2 SET DR=".02CPT Code;.03Printed test name;.08Max number of results allowed;.09Max age of result allowed (mos);.06Point of care test"
+1 LOCK +^VEN(7.41,TIEN):0
IF $TEST
DO ^DIE
LOCK -^VEN(7.41,TIEN)
WRITE !
+2 ; ADD MORE TESTS TO THE FORM
GOTO LAB1
+3 ;
GRAPH ; EP - GRAPHS ASSOCIATED WITH THE FORM
+1 WRITE !!,SEP," GRAPHS ",SEP
+2 WRITE !!,"Want to include graphs of measurable results on this form"
+3 SET %=2
+4 ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
IF $ORDER(^VEN(7.41,TIEN,6,0))
SET %=1
+5 DO YN^DICN
+6 IF %Y=U
WRITE !!,SEP
GOTO LAB
+7 IF %Y?2."^"
GOTO FIN
+8 SET DA(1)=TIEN
SET DIC="^VEN(7.41,"_DA(1)_",6,"
+9 ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
IF %=2
IF $ORDER(^VEN(7.41,DA(1),6,0))
IF '$$OK("graphs")
GOTO GRAPH1
+10 IF %=2
Begin DoDot:1
+11 SET DA(1)=TIEN
SET DIK=DIC
SET DA=0
+12 FOR
SET DA=$ORDER(^VEN(7.41,DA(1),6,DA))
IF 'DA
QUIT
DO ^DIK
+13 QUIT
End DoDot:1
GOTO KB
GRAPH1 SET DIC("P")="19707.416P"
SET DIC(0)="AEQL"
SET DLAYGO=19707.416
+1 SET DIC("A")="Enter the name of "_$SELECT($DATA(^VEN(7.41,TIEN,6)):"another",1:"a")_" graph: "
+2 DO ^DIC
IF Y=-1
GOTO KB
+3 SET DA=+Y
SET DIE=DIC
+4 IF $PIECE(Y,U,3)
WRITE !
GOTO GRAPH1
+5 WRITE !,"This graph already is on the form. Want to delete it"
+6 SET %=2
+7 DO YN^DICN
+8 IF %=1
SET DIK=DIC
DO ^DIK
+9 ; ADD MORE GRAPHS TO THE FORM
WRITE !
GOTO GRAPH1
+10 ;
KB ; EP - KNOWLEDGEBASE ASSOCIATED WITH THE FORM
+1 WRITE !!,SEP," KNOWLEDGEBASES ",SEP
+2 WRITE !,"A knowledgebase contains custom guidelines or patient education topics."
+3 SET %=2
+4 IF $ORDER(^VEN(7.41,TIEN,19,0))
SET %=1
Begin DoDot:1
+5 WRITE !,"This form already contains the following knowledgebase(s): "
+6 SET KIEN=0
FOR
SET KIEN=$ORDER(^VEN(7.41,TIEN,19,"B",KIEN))
IF 'KIEN
QUIT
Begin DoDot:2
+7 SET KNM=$PIECE($GET(^VEN(7.13,KIEN,0)),U)
+8 WRITE !?3,KNM
+9 QUIT
End DoDot:2
+10 WRITE !!
+11 QUIT
End DoDot:1
+12 WRITE !,"Want to include knowledgebase(s) on this form"
+13 DO YN^DICN
+14 ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
IF %Y=U
WRITE !!,SEP
GOTO GRAPH
+15 IF %Y?2."^"
GOTO FIN
+16 SET DA(1)=TIEN
SET DIC="^VEN(7.41,"_DA(1)_",19,"
+17 ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
IF %=2
IF $ORDER(^VEN(7.41,DA(1),19,0))
IF '$$OK("knowledgebases")
GOTO KB1
+18 IF %=2
Begin DoDot:1
+19 SET DA(1)=TIEN
SET DIK=DIC
SET DA=0
+20 FOR
SET DA=$ORDER(^VEN(7.41,DA(1),19,DA))
IF 'DA
QUIT
DO ^DIK
+21 QUIT
End DoDot:1
GOTO GG
KB1 SET DIC("P")="19707.4119P"
SET DIC(0)="AEQL"
SET DLAYGO=19707.4119
+1 SET DIC("A")="Enter the name of a knowledgebase clinical domain: "
+2 ; ASSIGN A KB CLINICAL DOMAIN TO THE TEMPLATE
DO ^DIC
IF Y=-1
GOTO GG
+3 SET DA=+Y
+4 ; AUTOMATICALLY ASSIGN AN ORDER
IF '$PIECE(^VEN(7.41,TIEN,19,DA,0),U,2)
SET $PIECE(^(0),U,2)=(DA*5)+100
+5 ; CHECK TO SEE IF THE KB DOMAINE IS ALREADY ASSIGNED. IF SO, DOES IT NEED OT BE REMOVED
IF $PIECE(Y,U,3)
WRITE !
GOTO KB1
+6 WRITE !,"This knowledgebase already is on the form. Want to delete it"
+7 SET %=2
+8 DO YN^DICN
+9 IF %=1
SET DIK=DIC
DO ^DIK
+10 ; ADD MORE GRAPHS TO THE FORM
WRITE !
GOTO KB1
+11 ;
GG ; EP - GROWTH GRIDS FOR WELL CHILD FORM
+1 SET GGIEN=$ORDER(^VEN(7.62,"B","PEDS GROWTH CHART",0))
SET %=2
+2 ; THE PEDS GROWTH CHART OCX IS UNAVAILABLE
IF 'GGIEN
GOTO CL
+3 WRITE !!,SEP," PEDIATRIC GROWTH GRIDS ",SEP
+4 IF $DATA(^VEN(7.62,GGIEN,6,"B",TIEN))
SET %=1
+5 WRITE !!,"Want to include Pediatric Growth Grids on the form"
+6 DO YN^DICN
+7 IF %=1
GOTO GG1
+8 IF %Y=U
WRITE !!
GOTO KB
+9 IF %Y?2."^"
GOTO FIN
GGD ; DELETE GRID FROM FORM
IF $DATA(^VEN(7.62,GGIEN,6,"B",TIEN))
IF %=2
Begin DoDot:1
+1 WRITE !,"Sure you want to remove the Grids from this template"
+2 SET %=2
DO YN^DICN
+3 IF %'=1
DO ^XBFMK
QUIT
+4 SET DA(1)=GGIEN
+5 SET DIK="^VEN(7.62,"_DA(1)_",6,"
+6 SET DA=$ORDER(^VEN(7.62,GGIEN,6,"B",TIEN,0))
IF 'DA
QUIT
+7 DO ^DIK
+8 DO ^XBFMK
+9 QUIT
End DoDot:1
GOTO CL
+10 ; PATCHED BY GIS/OIT 01/10/06 ; PCC+ 2.5 PATCH 2
QUIT
+11 ;
GG1 ; EP - UPDATE THE OCX COMPONENTS FILE
+1 SET DA(1)=GGIEN
+2 SET DIC="^VEN(7.62,"_DA(1)_",6,"
SET DIC(0)="L"
+3 SET DLAYGO=19707.626
+4 SET DIC("P")=19707.626
+5 SET X="`"_TIEN
+6 DO ^DIC
IF Y=-1
GOTO CL
+7 WRITE !,"OK, you may now add Pediatric Growth Grids to this template"
+8 WRITE !,"If 'blank' graphs appear on the printed form, you should review"
+9 WRITE !,"section 5 in the PCC+ users guide to learn about the 'blank graph' remedy"
CL ; CHECKLISTS
+1 WRITE !!,SEP," CHECKLISTS ",SEP
+2 WRITE !,"A checklist contains a set of orderable items or clinical tasks"
+3 WRITE !!,"Want to include checklists(s) on this form"
+4 SET %=2
+5 ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
IF $ORDER(^VEN(7.41,TIEN,17,0))
SET %=1
+6 DO YN^DICN
+7 IF %Y=U
GOTO GG
+8 IF %Y?2."^"
GOTO FIN
+9 SET DA(1)=TIEN
SET DIC="^VEN(7.41,"_DA(1)_",17,"
+10 ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
IF %=2
IF $ORDER(^VEN(7.41,DA(1),17,0))
IF '$$OK("checklists")
GOTO CL1
+11 IF %=2
Begin DoDot:1
+12 SET DA(1)=TIEN
SET DIK=DIC
SET DA=0
+13 FOR
SET DA=$ORDER(^VEN(7.41,DA(1),17,DA))
IF 'DA
QUIT
DO ^DIK
+14 ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
SET %=$NAME(^VEN(7.41,TIEN))
SET $PIECE(@%@(0),U,17)=0
+15 QUIT
End DoDot:1
GOTO HX
CL1 ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
SET %=$NAME(^VEN(7.41,TIEN))
SET $PIECE(@%@(0),U,17)=1
+1 SET DIC("P")="19707.4117P"
SET DIC(0)="AEQL"
SET DLAYGO=19707.4117
+2 SET DIC("A")="Enter the name of "_$SELECT($DATA(^VEN(7.41,TIEN,17)):"another",1:"a")_" checklist: "
+3 DO ^DIC
IF Y=-1
GOTO HX
+4 SET DA=+Y
SET DIE=DIC
+5 IF $PIECE(Y,U,3)
WRITE !
GOTO CL1
+6 WRITE !,"This checklist already is on the form. Want to delete it"
+7 SET %=2
+8 DO YN^DICN
+9 IF %=1
SET DIK=DIC
DO ^DIK
+10 ; ADD MORE GRAPHS TO THE FORM
WRITE !
GOTO CL1
+11 ;
HX ; EP - PATIENT HX
+1 WRITE !!,SEP," HISTORICAL INFORMATION ",SEP
HX1 WRITE !!,"Want to include personal history items on the form"
+1 SET %=2
+2 IF $PIECE($GET(^VEN(7.41,TIEN,5)),U,9)
SET %=1
+3 SET Z=$GET(FLD(5.09))
IF $LENGTH(Z)
SET %=$SELECT(Z=1:1,1:2)
+4 DO YN^DICN
+5 IF %Y=U
GOTO CL
+6 IF %Y?2."^"
GOTO FIN
+7 SET FLD(5.09)=$SELECT(%=1:1,1:0)
+8 IF %'=1
GOTO HX3
HX2 WRITE !!,"Want to exclude the onset date from the personal history"
+1 SET %=2
+2 IF $PIECE($GET(^VEN(7.41,TIEN,5)),U,10)
SET %=1
+3 SET Z=$GET(FLD(5.1))
IF $LENGTH(Z)
SET %=$SELECT(Z=1:1,1:2)
+4 DO YN^DICN
+5 IF %Y=U
GOTO HX1
+6 IF %Y?2."^"
GOTO FIN
+7 SET FLD(5.1)=$SELECT(%=1:1,1:0)
HX3 WRITE !!,"Want to include family history items on this form"
+1 SET %=2
+2 IF $PIECE($GET(^VEN(7.41,TIEN,5)),U,8)
SET %=1
+3 SET Z=$GET(FLD(5.08))
IF $LENGTH(Z)
SET %=$SELECT(Z=1:1,1:2)
+4 DO YN^DICN
+5 IF %Y=U
GOTO HX1
+6 IF %Y?2."^"
GOTO FIN
+7 SET FLD(5.08)=$SELECT(%=1:1,1:0)
HX4 WRITE !!,"Want to include past surgical procedures on this form"
+1 SET %=2
+2 IF $PIECE($GET(^VEN(7.41,TIEN,5)),U,8)
SET %=1
+3 SET Z=$GET(FLD(5.04))
IF $LENGTH(Z)
SET %=$SELECT(Z=1:1,1:2)
+4 DO YN^DICN
+5 IF %Y=U
GOTO HX3
+6 IF %Y?2."^"
GOTO FIN
+7 IF %'=1
GOTO FIN
+8 SET FLD(5.04)=$SELECT(%=1:1,1:0)
HX5 WRITE !!,"Want to include the diagnosis with the procedure"
+1 SET %=1
+2 IF '$PIECE($GET(^VEN(7.41,TIEN,5)),U,8)
SET %=2
+3 SET Z=$GET(FLD(5.05))
IF $LENGTH(Z)
SET %=$SELECT(Z=1:1,1:2)
+4 DO YN^DICN
+5 IF %Y=U
GOTO HX4
+6 IF %Y?2."^"
GOTO FIN
+7 SET FLD(5.05)=$SELECT(%=1:1,1:0)
HX6 WRITE !!,"Want to include the operating provider with the procedure"
+1 SET %=1
+2 IF '$PIECE($GET(^VEN(7.41,TIEN,5)),U,8)
SET %=2
+3 SET Z=$GET(FLD(5.06))
IF $LENGTH(Z)
SET %=$SELECT(Z=1:1,1:2)
+4 DO YN^DICN
+5 IF %Y=U
GOTO HX5
+6 IF %Y?2."^"
GOTO FIN
+7 SET FLD(5.06)=$SELECT(%=1:1,1:0)
HX7 WRITE !!,"Want to exclude minor procedures from the list"
+1 SET %=2
+2 IF $PIECE($GET(^VEN(7.41,TIEN,5)),U,8)
SET %=1
+3 SET Z=$GET(FLD(5.07))
IF $LENGTH(Z)
SET %=$SELECT(Z=1:1,1:2)
+4 DO YN^DICN
+5 IF %Y=U
GOTO HX6
+6 IF %Y?2."^"
GOTO FIN
+7 SET FLD(5.07)=$SELECT(%=1:1,1:0)
HX8 WRITE !!,"Want to display only the last major procedure"
+1 SET %=2
+2 IF $PIECE($GET(^VEN(7.41,TIEN,5)),U,8)
SET %=1
+3 SET Z=$GET(FLD(5.11))
IF $LENGTH(Z)
SET %=$SELECT(Z=1:1,1:2)
+4 DO YN^DICN
+5 IF %Y=U
GOTO HX7
+6 IF %Y?2."^"
GOTO FIN
+7 SET FLD(5.11)=$SELECT(%=1:1,1:0)
HX9 WRITE !!,"Want to display the ICD code associated with the procedure"
+1 SET %=1
+2 IF '$PIECE($GET(^VEN(7.41,TIEN,5)),U,8)
SET %=2
+3 DO YN^DICN
+4 IF %Y=U
GOTO HX8
+5 IF %Y?2."^"
GOTO FIN
+6 SET FLD(5.12)=$SELECT(%=1:1,1:0)
HXDIE DO DIE^VENPCCIT(TIEN)
+1 WRITE !!,SEP,!!,"CONGRATULATIONS! This template's definition is now complete..."
+2 WRITE !,"Be sure to copy the template '"_TMN_"_template.doc on to BOTH print severs"
+3 WRITE !,"Then check template synchronization with the 'TS' option on the"
+4 WRITE !,"PCC+ Install menu. It is no longer necessary to make a companion file."
+5 WRITE !,"You can edit the properties of '",TNM,"' at any"
+6 WRITE !,"time by running this utility again.",!!,SEP,!!
FIN DO ^XBFMK
+1 QUIT
+2 ;
GRADD ; EP - ENTER A NEW GRAPH
+1 NEW NAME,TYPE,LFILE,MFILE,FILE,MM,MDP,UNIT,X,Y,Z,%,DIC,DA,DR,DIE,DIR,DTOUT,GIEN
GRA1 SET DIR(0)="F^3:30"
SET DIR("A")="Name of graph"
+1 DO ^DIR
KILL DIR
+2 IF $DATA(DTOUT)
GOTO GRAX
+3 IF Y?1."^"
GOTO GRAX
+4 IF Y'?1U2.29UN
WRITE " ??"
GOTO GRA1
+5 IF $DATA(^VEN(7.63,"B",Y))
WRITE !,"This graph name already exists! Enter another name..."
GOTO GRA1
+6 SET DIC(0)="L"
SET X=""""_Y_""""
+7 SET DIC="^VEN(7.63,"
SET DLAYGO=19707.63
+8 DO ^DIC
IF Y=-1
QUIT
+9 WRITE !,"This name will also be used as the graph's title",!
+10 SET GIEN=+Y
SET NAME=$PIECE(Y,U,2)
GRA2 SET DIR(0)="S^M:MEASUREMENT;L:LAB TEST RESULT"
SET DIR("A")="Data type"
SET DIR("B")=$GET(TYPE)
+1 DO ^DIR
KILL DIR
+2 IF $DATA(DTOUT)
GOTO GRAX
+3 IF Y?1."^"
GOTO GRAX
+4 SET TYPE=Y
GRAM ; GET MEASUREMENT ENTRY
+1 IF TYPE="L"
GOTO GRAL
+2 IF TYPE'="M"
GOTO GRAX
+3 SET DIC("A")="Enter the associated MEASUREMENT file entry: "
+4 IF $DATA(^AUTTMSR("B",NAME))
SET DIC("B")=NAME
+5 IF $LENGTH($GET(MFILE))
SET DIC("B")=MFILE
+6 SET DIC(0)="AEQM"
SET DIC="^AUTTMSR("
+7 DO ^DIC
IF Y=-1
GOTO GRAX
+8 SET FILE=+Y
SET MFILE=$PIECE(Y,U,2)
+9 GOTO GRAMM
+10 ;
GRAL ; EP - GET LAB RESULT ENTRY
+1 SET DIC("A")="Enter the associated LAB file entry: "
+2 IF $DATA(^LAB(60,"B",NAME))
SET DIC("B")=NAME
+3 IF $LENGTH($GET(LFILE))
SET DIC("B")=LFILE
+4 SET DIC(0)="AEQM"
SET DIC="^LAB(60,"
+5 DO ^DIC
IF Y=-1
GOTO GRAX
+6 SET FILE=+Y
SET LFILE=$PIECE(Y,U,2)
GRAMM ; MAX MONTHS
+1 SET DIR(0)="NO^1:300:0"
SET DIR("A")="Enter the max months displayed in this graph"
+2 SET DIR("B")=24
IF $GET(MM)
SET DIR("B")=MM
+3 DO ^DIR
KILL DIR
+4 IF $DATA(DTOUT)
GOTO GRAX
+5 IF Y=U
WRITE !
GOTO GRAM
+6 IF Y?2."^"
GOTO GRAX
+7 SET MM=Y
GRAD ; MAX DATA POINTS
+1 SET DIR(0)="NO^1:999:0"
SET DIR("A")="Enter the max # data points displayed in this graph"
+2 SET DIR("B")=10
IF $GET(MDP)
SET DIR("B")=MDP
+3 DO ^DIR
KILL DIR
+4 IF $DATA(DTOUT)
GOTO GRAX
+5 IF Y=U
WRITE !
GOTO GRAMM
+6 IF Y?2."^"
GOTO GRAX
+7 SET MDP=Y
GRAU ; UNITS
+1 SET DIR(0)="FO^3:30"
SET DIR("A")="Units represented in this graph"
+2 IF $LENGTH($GET(UNIT))
SET DIR("B")=UNIT
+3 DO ^DIR
KILL DIR
+4 IF $DATA(DTOUT)
GOTO GRAX
+5 IF Y=U
WRITE !
GOTO GRAD
+6 IF Y?2."^"
GOTO GRAX
+7 SET UNIT=Y
+8 IF UNIT="@"
SET UNIT=""
+9 IF $LENGTH(UNIT)
WRITE !,"The unit '",UNIT,"' will be used as the y-axis label",!
GRAF ; FILE THE RESULTS
+1 SET DIE="^VEN(7.63,"
SET DA=GIEN
+2 SET DR=".02///^S X=TYPE;.03///^S X=MM;.04///^S X=MDP;.05///^S X=NAME;.08///^S X=UNIT"
+3 IF $LENGTH($GET(MFILE))
SET DR=DR_";.11///^S X=FILE"
+4 IF $LENGTH($GET(LFILE))
SET DR=DR_";.12///^S X=FILE"
+5 DO ^DIE
+6 WRITE !,"This graph has been added to PCC+.",!,"Use the TCU option to attach it to specific PCC+ templates."
GRAX DO ^XBFMK
+1 QUIT
+2 ;
GRED ; EP - EDIT A GRAPH'S PROPERTIES
+1 NEW DIC,DIE,DR,DA,X,Y,%,TYPE
+2 SET DIC="^VEN(7.63,"
SET DIC(0)="AEQ"
SET DIC("A")="Which graph do you want to edit: "
+3 DO ^DIC
IF Y=-1
GOTO GREX
+4 SET DA=+Y
SET DIE=DIC
SET DR=".02"
DO ^DIE
+5 SET TYPE=$PIECE($GET(^VEN(7.63,DA,0)),U,2)
+6 IF TYPE=""
WRITE !,"No data type specified. Graph entry will be deleted!",!
NEW DIK
GOTO GRDEL
+7 IF TYPE=1
SET DR=".11Associated MEASUREMENT file entry"
+8 IF TYPE=2
SET DR=".12Associated LAB file entry"
+9 SET DR=DR_";.03;.04;.08"
+10 DO ^DIE
WRITE !,"The properties of this graph have been updated...",!
GREX DO ^XBFMK
+1 QUIT
+2 ;
GRD ; EP - DELETE A GRAPH
+1 NEW DIK,DIC,X,Y,NAME,GRIEN,TIEN,GIEN
+2 SET DIC("A")="Which graph do you want to delete: "
+3 SET DIC="^VEN(7.63,"
SET DIC(0)="AEQ"
+4 DO ^DIC
IF Y=-1
GOTO GRAX
+5 SET GRIEN=+Y
SET NAME=$PIECE(Y,U,2)
+6 WRITE !,"WARNING: This will remove this graph from PCC+ and ",!,"detach it from all PCC+ templates..."
+7 WRITE !,"Are you sure you want to delete this graph"
+8 SET %=0
DO YN^DICN
IF %'=1
GOTO GRAX
GRDT ; REMOVE GRAPH FROM INDIVIDUAL TEMPLATES
+1 SET TIEN=0
+2 ; REMOVE GRAPH FROM ALL TEMPLATE DEFINITIONS
FOR
SET TIEN=$ORDER(^VEN(7.41,TIEN))
IF 'TIEN
QUIT
Begin DoDot:1
+3 SET GIEN=0
FOR
SET GIEN=$ORDER(^VEN(7.41,TIEN,6,"B",GRIEN,GIEN))
IF 'GIEN
QUIT
Begin DoDot:2
+4 SET DA(1)=TIEN
SET DA=GIEN
+5 SET DIK="^VEN(7.41,"_DA(1)_",6,"
+6 DO ^DIK
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
+9 KILL DIK
GRDEL ; REMOVE GRAPH DEFINITION
SET DIK="^VEN(7.63,"
SET DA=GRIEN
+1 IF '$DATA(^VEN(7.63,+$GET(DA)))
QUIT
+2 DO ^DIK
WRITE !,NAME," deleted..."
+3 DO ^XBFMK
+4 QUIT
+5 ;
OK(TXT) ; EP - CONFRIM REMOVAL OF ITEMS
+1 ; PATCHED BY GIS/OIT 10/15/05 ; PCC+ 2.5 PATCH 1
+2 NEW %,%Y
+3 SET TXT=$SELECT($LENGTH($GET(TXT)):TXT,1:"items")
+4 WRITE !,"This will remove ALL ",TXT," from the form!!!"
+5 WRITE !,"Are you sure you want to do this"
+6 SET %=2
+7 DO YN^DICN
+8 IF %=1
QUIT 1
+9 QUIT 0
+10 ;
