APCHMT1 ; IHS/CMI/LAB -- CONTINUATION OF ROUTINES ; 15 Sep 2010 8:15 AM
;;2.0;IHS PCC SUITE;**5,7**;MAY 14, 2009
;; ;
;routine to create/modify a health summary type
;
BACK ;go back to listman
D TERM^VALM0
S VALMBCK="R"
D INIT^APCHMT
D HDR^APCHMT
K DIR
K X,Y,Z,I
Q
COMP(S,C) ;EP
NEW X,Y S Y=0,X=0 F S X=$O(^APCHSCTL(S,1,X)) Q:X'=+X!(Y) I $P(^APCHSCTL(S,1,X,0),U,2)=C S Y=1
Q Y
HS ;EP called from protocol to generate hs
D FULL^VALM1
S DFN=""
S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DLAYGO,DIADD
I Y<0 W !,"No Patient Selected." D BACK Q
S DFN=+Y
S Y=DFN D ^AUPNPAT
S APCHSTYP=APCHDA
S APCHSPAT=DFN
S %=$P(^APCHSCTL(APCHDA,0),U)_" Health Summary for "_$P(^DPT(APCHSPAT,0),U)
D VIEWR^XBLM("EN^APCHS",%) S APCHDA=APCHSTYP
D BACK
Q
GEN ;EP
D FULL^VALM1
S DA=APCHDA,DIE="^APCHSCTL(",DR="1.5;2;3;3.6;3.7;3.8;3.9T" D ^DIE,^XBFMK
D BACK
Q
MSUP ;EP - called from protocol entry
D FULL^VALM1
I '$$COMP(APCHDA,$O(^APCHSCMP("B","SUPPLEMENTS",0))) W !!,"WARNING: SUPPLEMENTS has not been added to the Health Summary Structure.",! D
.W "The SUPPLEMENTS you add to this panel will not display until SUPPLEMENTS is a part",!,"of the summary structure."
W !
S DA=APCHDA,DIE="^APCHSCTL(",DR=12 D ^DIE,^XBFMK
D BACK
Q
MCS ;EP - called from protocol entry
D FULL^VALM1
I '$$COMP(APCHDA,$O(^APCHSCMP("B","OUTPATIENT VISITS (SCREENED)",0))) W !!,"WARNING: OUTPATIENT VISITS SCREENED has not been added to the Health Summary",!,"structure. Entering clinic values into this field will have no affect",! D
.W "unless OUTPATIENT VISITS (SCREENED) is added to the structure."
W !!,"If the clinic of a visit is a clinic that matches one entered",!,"into this field the visit will NOT display on the summary",!,"in the OUTPATIENT VISITS (SCREENED) section."
W !!,"To remove a clinic from being screened out of this summary",!,"type the clinic code or name and type an '@',",!
S DA=APCHDA,DIE="^APCHSCTL(",DR=11 D ^DIE,^XBFMK
D BACK
Q
MPS ;EP - called from protocol entry
D FULL^VALM1
I '$$COMP(APCHDA,$O(^APCHSCMP("B","OUTPATIENT VISITS (SCREENED)",0))) W !!,"WARNING: OUTPATIENT VISITS SCREENED has not been added to the Health Summary",!,"structure. Entering Provider class values into this field will have no affect",! D
.W "unless OUTPATIENT VISITS (SCREENED) is added to the structure."
W !!,"If the primary provider on a visit has a provider class that matches one entered",!,"into this field the visit will NOT display on the summary",!,"in the OUTPATIENT VISITS (SCREENED) section."
W !!,"To remove a provider class from being screened out of this summary",!,"type the provider class code and type an '@',",!
S DA=APCHDA,DIE="^APCHSCTL(",DR=9 D ^DIE,^XBFMK
D BACK
Q
MH ;EP - called from protocol entry
D FULL^VALM1
I '$$COMP(APCHDA,$O(^APCHSCMP("B","HEALTH FACTORS",0))) W !!,"WARNING: HEALTH FACTORS has not been added to the Health Summary Structure.",!,"HEALTH FACTORS will not display until they are part of the summary",!,"structure."
W !!,"If you want all HEALTH FACTOR categories to display on your summary",!,"then DO NOT update this field. If it is left blank then all HEALTH FACTOR",!,"categories will display. If you want only selected HEALTH FACTOR categories",!
W "to display on this summary type then enter them into this field."
W !!,"You can add a new HEALTH FACTOR category by entering a new sequence number",!,"and HEALTH FACTOR category name.",!,"To remove a HEALTH FACTOR category from this summary type select the category",!
W "by sequence number and type an '@',",!
S DA=APCHDA,DIE="^APCHSCTL(",DR=8 D ^DIE,^XBFMK
D BACK
Q
MF ;EP - called from protocol entry
D FULL^VALM1
I '$$COMP(APCHDA,$O(^APCHSCMP("B","FLOWSHEETS",0))) W !!,"WARNING: FLOWSHEETS has not been added to the Health Summary Structure.",!,"FLOWSHEETS will not display until they are part of the summary",!,"structure."
W !!,"You can add a new FLOWSHEET by entering a new sequence number",!,"and FLOWSHEET name. The FLOWSHEET must have been added using",!
W "the option 'Create/Modify Flowsheet' in order to be selected.",!,"To remove a FLOWSHEET from this summary type select the FLOWSHEET",!
W "by sequence number and type an '@',",!
S DA=APCHDA,DIE="^APCHSCTL(",DR=7 D ^DIE,^XBFMK
D BACK
Q
ML ;EP - called from protocol entry
D FULL^VALM1
I '$$COMP(APCHDA,$O(^APCHSCMP("B","LABORATORY DATA",0))) W !!,"WARNING: LABORATORY DATA has not been added to the Health Summary Structure.",! D
.W "The LABS you put on the panel will not display until LABORATORY DATA is a part",!,"of the summary structure."
W !!,"You can add a new LAB TEST by entering a new sequence number and",!,"the LAB TEST name. To remove a LAB TEST from this summary type select the",!,"LAB TEST by name or sequence number and then enter an '@'.",!
D FULL^VALM1
S DA=APCHDA,DIE="^APCHSCTL(",DR=5 D ^DIE,^XBFMK
D BACK
Q
MP ;EP - called from protocol entry
D FULL^VALM1
I '$$COMP(APCHDA,$O(^APCHSCMP("B","MEASUREMENT PANELS",0))) W !!,"WARNING: Measurement Panels has not been added to the Health Summary Structure.",!,"Measurement panels will not display until they are part of the summary",!,"structure."
W !!,"You can add a new measurement panel by entering a new sequence number",!,"and measurement panel name. The measurement panel must have been added using",!
W "the option 'Create/Modify Measurement Panel' in order to be selected.",!,"To remove a measurement panel from this summary type select the measurement",!
W "panel by sequence number and type an '@',",!
S DA=APCHDA,DIE="^APCHSCTL(",DR=4 D ^DIE,^XBFMK
D BACK
Q
MS ;EP - called from protocol entry
D FULL^VALM1
W !!,"You can add a new component by entering a new order number and",!,"component name. To remove a component from this summary type select the",!,"component by name or order and then enter an '@'.",!
S DA=APCHDA,DIE="^APCHSCTL(",DR="[APCH MOD STRUCTURE]" D ^DIE,^XBFMK
D BACK
Q
PAUSE ;EP; -- ask user to press ENTER
Q:IOST'["C-"
NEW Y S Y=$$READ("E","Press ENTER to continue") D ^XBCLS Q
READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN,DIRA) ;EP; calls reader, returns response
NEW DIR,X,Y
S DIR(0)=TYPE
I $D(SCREEN) S DIR("S")=SCREEN
I $G(PROMPT)]"" S DIR("A")=PROMPT
I $G(DEFAULT)]"" S DIR("B")=DEFAULT
I $D(HELP) S DIR("?")=HELP
I $D(DIRA(1)) S Y=0 F S Y=$O(DIRA(Y)) Q:Y="" S DIR("A",Y)=DIRA(Y)
D ^DIR
Q Y
APCHMT1 ; IHS/CMI/LAB -- CONTINUATION OF ROUTINES ; 15 Sep 2010 8:15 AM
+1 ;;2.0;IHS PCC SUITE;**5,7**;MAY 14, 2009
+2 ;; ;
+3 ;routine to create/modify a health summary type
+4 ;
BACK ;go back to listman
+1 DO TERM^VALM0
+2 SET VALMBCK="R"
+3 DO INIT^APCHMT
+4 DO HDR^APCHMT
+5 KILL DIR
+6 KILL X,Y,Z,I
+7 QUIT
COMP(S,C) ;EP
+1 NEW X,Y
SET Y=0
SET X=0
FOR
SET X=$ORDER(^APCHSCTL(S,1,X))
IF X'=+X!(Y)
QUIT
IF $PIECE(^APCHSCTL(S,1,X,0),U,2)=C
SET Y=1
+2 QUIT Y
HS ;EP called from protocol to generate hs
+1 DO FULL^VALM1
+2 SET DFN=""
+3 SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA,DR,DLAYGO,DIADD
+4 IF Y<0
WRITE !,"No Patient Selected."
DO BACK
QUIT
+5 SET DFN=+Y
+6 SET Y=DFN
DO ^AUPNPAT
+7 SET APCHSTYP=APCHDA
+8 SET APCHSPAT=DFN
+9 SET %=$PIECE(^APCHSCTL(APCHDA,0),U)_" Health Summary for "_$PIECE(^DPT(APCHSPAT,0),U)
+10 DO VIEWR^XBLM("EN^APCHS",%)
SET APCHDA=APCHSTYP
+11 DO BACK
+12 QUIT
GEN ;EP
+1 DO FULL^VALM1
+2 SET DA=APCHDA
SET DIE="^APCHSCTL("
SET DR="1.5;2;3;3.6;3.7;3.8;3.9T"
DO ^DIE
DO ^XBFMK
+3 DO BACK
+4 QUIT
MSUP ;EP - called from protocol entry
+1 DO FULL^VALM1
+2 IF '$$COMP(APCHDA,$ORDER(^APCHSCMP("B","SUPPLEMENTS",0)))
WRITE !!,"WARNING: SUPPLEMENTS has not been added to the Health Summary Structure.",!
Begin DoDot:1
+3 WRITE "The SUPPLEMENTS you add to this panel will not display until SUPPLEMENTS is a part",!,"of the summary structure."
End DoDot:1
+4 WRITE !
+5 SET DA=APCHDA
SET DIE="^APCHSCTL("
SET DR=12
DO ^DIE
DO ^XBFMK
+6 DO BACK
+7 QUIT
MCS ;EP - called from protocol entry
+1 DO FULL^VALM1
+2 IF '$$COMP(APCHDA,$ORDER(^APCHSCMP("B","OUTPATIENT VISITS (SCREENED)",0)))
WRITE !!,"WARNING: OUTPATIENT VISITS SCREENED has not been added to the Health Summary",!,"structure. Entering clinic values into this field will have no affect",!
Begin DoDot:1
+3 WRITE "unless OUTPATIENT VISITS (SCREENED) is added to the structure."
End DoDot:1
+4 WRITE !!,"If the clinic of a visit is a clinic that matches one entered",!,"into this field the visit will NOT display on the summary",!,"in the OUTPATIENT VISITS (SCREENED) section."
+5 WRITE !!,"To remove a clinic from being screened out of this summary",!,"type the clinic code or name and type an '@',",!
+6 SET DA=APCHDA
SET DIE="^APCHSCTL("
SET DR=11
DO ^DIE
DO ^XBFMK
+7 DO BACK
+8 QUIT
MPS ;EP - called from protocol entry
+1 DO FULL^VALM1
+2 IF '$$COMP(APCHDA,$ORDER(^APCHSCMP("B","OUTPATIENT VISITS (SCREENED)",0)))
WRITE !!,"WARNING: OUTPATIENT VISITS SCREENED has not been added to the Health Summary",!,"structure. Entering Provider class values into this field will have no affect",!
Begin DoDot:1
+3 WRITE "unless OUTPATIENT VISITS (SCREENED) is added to the structure."
End DoDot:1
+4 WRITE !!,"If the primary provider on a visit has a provider class that matches one entered",!,"into this field the visit will NOT display on the summary",!,"in the OUTPATIENT VISITS (SCREENED) section."
+5 WRITE !!,"To remove a provider class from being screened out of this summary",!,"type the provider class code and type an '@',",!
+6 SET DA=APCHDA
SET DIE="^APCHSCTL("
SET DR=9
DO ^DIE
DO ^XBFMK
+7 DO BACK
+8 QUIT
MH ;EP - called from protocol entry
+1 DO FULL^VALM1
+2 IF '$$COMP(APCHDA,$ORDER(^APCHSCMP("B","HEALTH FACTORS",0)))
WRITE !!,"WARNING: HEALTH FACTORS has not been added to the Health Summary Structure.",!,"HEALTH FACTORS will not display until they are part of the summary",!,"structure."
+3 WRITE !!,"If you want all HEALTH FACTOR categories to display on your summary",!,"then DO NOT update this field. If it is left blank then all HEALTH FACTOR",!,"categories will display. If you want only selected HEALTH FACTOR categories",!
+4 WRITE "to display on this summary type then enter them into this field."
+5 WRITE !!,"You can add a new HEALTH FACTOR category by entering a new sequence number",!,"and HEALTH FACTOR category name.",!,"To remove a HEALTH FACTOR category from this summary type select the category",!
+6 WRITE "by sequence number and type an '@',",!
+7 SET DA=APCHDA
SET DIE="^APCHSCTL("
SET DR=8
DO ^DIE
DO ^XBFMK
+8 DO BACK
+9 QUIT
MF ;EP - called from protocol entry
+1 DO FULL^VALM1
+2 IF '$$COMP(APCHDA,$ORDER(^APCHSCMP("B","FLOWSHEETS",0)))
WRITE !!,"WARNING: FLOWSHEETS has not been added to the Health Summary Structure.",!,"FLOWSHEETS will not display until they are part of the summary",!,"structure."
+3 WRITE !!,"You can add a new FLOWSHEET by entering a new sequence number",!,"and FLOWSHEET name. The FLOWSHEET must have been added using",!
+4 WRITE "the option 'Create/Modify Flowsheet' in order to be selected.",!,"To remove a FLOWSHEET from this summary type select the FLOWSHEET",!
+5 WRITE "by sequence number and type an '@',",!
+6 SET DA=APCHDA
SET DIE="^APCHSCTL("
SET DR=7
DO ^DIE
DO ^XBFMK
+7 DO BACK
+8 QUIT
ML ;EP - called from protocol entry
+1 DO FULL^VALM1
+2 IF '$$COMP(APCHDA,$ORDER(^APCHSCMP("B","LABORATORY DATA",0)))
WRITE !!,"WARNING: LABORATORY DATA has not been added to the Health Summary Structure.",!
Begin DoDot:1
+3 WRITE "The LABS you put on the panel will not display until LABORATORY DATA is a part",!,"of the summary structure."
End DoDot:1
+4 WRITE !!,"You can add a new LAB TEST by entering a new sequence number and",!,"the LAB TEST name. To remove a LAB TEST from this summary type select the",!,"LAB TEST by name or sequence number and then enter an '@'.",!
+5 DO FULL^VALM1
+6 SET DA=APCHDA
SET DIE="^APCHSCTL("
SET DR=5
DO ^DIE
DO ^XBFMK
+7 DO BACK
+8 QUIT
MP ;EP - called from protocol entry
+1 DO FULL^VALM1
+2 IF '$$COMP(APCHDA,$ORDER(^APCHSCMP("B","MEASUREMENT PANELS",0)))
WRITE !!,"WARNING: Measurement Panels has not been added to the Health Summary Structure.",!,"Measurement panels will not display until they are part of the summary",!,"structure."
+3 WRITE !!,"You can add a new measurement panel by entering a new sequence number",!,"and measurement panel name. The measurement panel must have been added using",!
+4 WRITE "the option 'Create/Modify Measurement Panel' in order to be selected.",!,"To remove a measurement panel from this summary type select the measurement",!
+5 WRITE "panel by sequence number and type an '@',",!
+6 SET DA=APCHDA
SET DIE="^APCHSCTL("
SET DR=4
DO ^DIE
DO ^XBFMK
+7 DO BACK
+8 QUIT
MS ;EP - called from protocol entry
+1 DO FULL^VALM1
+2 WRITE !!,"You can add a new component by entering a new order number and",!,"component name. To remove a component from this summary type select the",!,"component by name or order and then enter an '@'.",!
+3 SET DA=APCHDA
SET DIE="^APCHSCTL("
SET DR="[APCH MOD STRUCTURE]"
DO ^DIE
DO ^XBFMK
+4 DO BACK
+5 QUIT
PAUSE ;EP; -- ask user to press ENTER
+1 IF IOST'["C-"
QUIT
+2 NEW Y
SET Y=$$READ("E","Press ENTER to continue")
DO ^XBCLS
QUIT
READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN,DIRA) ;EP; calls reader, returns response
+1 NEW DIR,X,Y
+2 SET DIR(0)=TYPE
+3 IF $DATA(SCREEN)
SET DIR("S")=SCREEN
+4 IF $GET(PROMPT)]""
SET DIR("A")=PROMPT
+5 IF $GET(DEFAULT)]""
SET DIR("B")=DEFAULT
+6 IF $DATA(HELP)
SET DIR("?")=HELP
+7 IF $DATA(DIRA(1))
SET Y=0
FOR
SET Y=$ORDER(DIRA(Y))
IF Y=""
QUIT
SET DIR("A",Y)=DIRA(Y)
+8 DO ^DIR
+9 QUIT Y
