APCDSTGC ; IHS/CMI/LAB - LIST MANAGER API'S FOR FAMILY HISTORY AND API FOR REP FACTORS ;
;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
;
;BJPC v1 patch 1
INPUT ;EP - called from input transform on Stage field
NEW A,T,C,H,L
S C=$P($G(^AUPNVPOV(DA,0)),U)
S A=0 F S A=$O(^APCDSTGC(A)) Q:A'=+A!('$D(X)) D
.S T=$P(^APCDSTGC(A,0),U,2)
.Q:T=""
.Q:'$D(^ATXAX(T))
.Q:'$$ICD^ATXAPI(C,T,9) ;not in this taxonomy
.S L=$P(^APCDSTGC(A,0),U,3)
.S H=$P(^APCDSTGC(A,0),U,4)
.I X<L!(X>H) K X
.Q
Q
;
HELP ;EP - Executable help from stage field of V POV
NEW A,T,C,H,L,G
S G=0
S C=$P($G(^AUPNVPOV(DA,0)),U)
S A=0 F S A=$O(^APCDSTGC(A)) Q:A'=+A!(G) D
.S T=$P(^APCDSTGC(A,0),U,2)
.Q:'$D(^ATXAX(T))
.Q:'$$ICD^ATXAPI(C,T,9) ;not in this taxonomy
.S G=1
.S H=0 F S H=$O(^APCDSTGC(A,12,H)) Q:H'=+H D
..D EN^DDIOL($G(^APCDSTGC(A,12,H,0)))
.Q
Q
;
EP(APCDDFN,APCDV,APCDI,APCDX) ;EP - called from xref on stage field of V POV
;APCDDFN=PATIENT DFN
;APCDV=VISIT IEN
;APCDX=VALUE
;APCDI=IEN OF V POV
NEW APCDA,APCDC,APCDT,C
S C=$P($G(^AUPNVPOV(APCDI,0)),U)
Q:C=""
S APCDA=0 F S APCDA=$O(^APCDSTGC(APCDA)) Q:APCDA'=+APCDA D
.S APCDT=$P(^APCDSTGC(APCDA,0),U,2)
.Q:'$D(^ATXAX(APCDT))
.Q:'$$ICD^ATXAPI(C,APCDT,9)
.I $G(^APCDSTGC(APCDA,13))]"" X ^APCDSTGC(APCDA,13)
.Q
Q
;
ASTH ;EP
D EN^XBNEW("ASTH1^APCDSTGC","APCDDFN;APCDV;APCDX;APCDI")
Q
;
ASTH1 ;EP - called from xbnew
;Add V Asthma Severity for this stage
;if V Asthma entry already exists on this day, overlay it
;if deleted, delete v astHma entry that matches
;
;first check to see if stage is blank, if it is find the V ASTHMA created by
;this pov and delete out the severity value, if there is no V ASTHMA then quit
;as there is nothing to delete
I $P($G(^AUPNVPOV(APCDI,0)),U,5)="" D Q
.S APCDB=0 F S APCDB=$O(^AUPNVAST("AD",APCDV,APCDB)) Q:APCDB'=+APCDB D
..Q:'$D(^AUPNVAST(APCDB,0)) ;bad xref
..Q:$P(^AUPNVAST(APCDB,0),U,13)'=APCDI ;not created by this pov so leave it alone
..S DA=APCDB,DIE="^AUPNVAST(",DR=".04///@" D ^DIE K DA,DR,DIE,DIU,DIV
..Q
.Q
;
;now find V ASTHMA created by this V POV and edit it, if none exists, add it
S APCDB=0,G=0 F S APCDB=$O(^AUPNVAST("AD",APCDV,APCDB)) Q:APCDB'=+APCDB!(G) D
.Q:'$D(^AUPNVAST(APCDB,0)) ;bad xref
.Q:$P(^AUPNVAST(APCDB,0),U,13)'=APCDI ;not this vpov
.S DA=APCDB,DIE="^AUPNVAST(",DR=".04///"_APCDX D ^DIE K DA,DIE,DIU,DIV
.S G=1
I G Q ;found one, editted it, quit
;add v asthma entry
;
ADDVAST ;
K APCDALVR
S APCDALVR("APCDATMP")="[APCDALVR 9000010.41 (ADD)]"
S APCDALVR("APCDPAT")=APCDDFN
S APCDALVR("APCDVSIT")=APCDV
S APCDALVR("APCDTSEV")=APCDX
S APCDALVR("APCDTPOV")="`"_APCDI
D ^APCDALVR
K APCDALVR
;if it fails, not much I can do but it shouldn't fail
Q
;
ASKSTG(C) ;EP - called from data entry input templates to determine whether stage should be prompted for this icd diagnosis
;C is ien of the icd9 entry
I $G(C)="" Q 0
NEW A,T,H
S A=0,H=0 F S A=$O(^APCDSTGC(A)) Q:A'=+A!(H) D
.S T=$P(^APCDSTGC(A,0),U,2)
.Q:T=""
.Q:'$D(^ATXAX(T))
.Q:'$$ICD^ATXAPI(C,T,9) ;not in this taxonomy
.S H=1
.Q
Q H
APCDSTGC ; IHS/CMI/LAB - LIST MANAGER API'S FOR FAMILY HISTORY AND API FOR REP FACTORS ;
+1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
+2 ;
+3 ;BJPC v1 patch 1
INPUT ;EP - called from input transform on Stage field
+1 NEW A,T,C,H,L
+2 SET C=$PIECE($GET(^AUPNVPOV(DA,0)),U)
+3 SET A=0
FOR
SET A=$ORDER(^APCDSTGC(A))
IF A'=+A!('$DATA(X))
QUIT
Begin DoDot:1
+4 SET T=$PIECE(^APCDSTGC(A,0),U,2)
+5 IF T=""
QUIT
+6 IF '$DATA(^ATXAX(T))
QUIT
+7 ;not in this taxonomy
IF '$$ICD^ATXAPI(C,T,9)
QUIT
+8 SET L=$PIECE(^APCDSTGC(A,0),U,3)
+9 SET H=$PIECE(^APCDSTGC(A,0),U,4)
+10 IF X<L!(X>H)
KILL X
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
HELP ;EP - Executable help from stage field of V POV
+1 NEW A,T,C,H,L,G
+2 SET G=0
+3 SET C=$PIECE($GET(^AUPNVPOV(DA,0)),U)
+4 SET A=0
FOR
SET A=$ORDER(^APCDSTGC(A))
IF A'=+A!(G)
QUIT
Begin DoDot:1
+5 SET T=$PIECE(^APCDSTGC(A,0),U,2)
+6 IF '$DATA(^ATXAX(T))
QUIT
+7 ;not in this taxonomy
IF '$$ICD^ATXAPI(C,T,9)
QUIT
+8 SET G=1
+9 SET H=0
FOR
SET H=$ORDER(^APCDSTGC(A,12,H))
IF H'=+H
QUIT
Begin DoDot:2
+10 DO EN^DDIOL($GET(^APCDSTGC(A,12,H,0)))
End DoDot:2
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
EP(APCDDFN,APCDV,APCDI,APCDX) ;EP - called from xref on stage field of V POV
+1 ;APCDDFN=PATIENT DFN
+2 ;APCDV=VISIT IEN
+3 ;APCDX=VALUE
+4 ;APCDI=IEN OF V POV
+5 NEW APCDA,APCDC,APCDT,C
+6 SET C=$PIECE($GET(^AUPNVPOV(APCDI,0)),U)
+7 IF C=""
QUIT
+8 SET APCDA=0
FOR
SET APCDA=$ORDER(^APCDSTGC(APCDA))
IF APCDA'=+APCDA
QUIT
Begin DoDot:1
+9 SET APCDT=$PIECE(^APCDSTGC(APCDA,0),U,2)
+10 IF '$DATA(^ATXAX(APCDT))
QUIT
+11 IF '$$ICD^ATXAPI(C,APCDT,9)
QUIT
+12 IF $GET(^APCDSTGC(APCDA,13))]""
XECUTE ^APCDSTGC(APCDA,13)
+13 QUIT
End DoDot:1
+14 QUIT
+15 ;
ASTH ;EP
+1 DO EN^XBNEW("ASTH1^APCDSTGC","APCDDFN;APCDV;APCDX;APCDI")
+2 QUIT
+3 ;
ASTH1 ;EP - called from xbnew
+1 ;Add V Asthma Severity for this stage
+2 ;if V Asthma entry already exists on this day, overlay it
+3 ;if deleted, delete v astHma entry that matches
+4 ;
+5 ;first check to see if stage is blank, if it is find the V ASTHMA created by
+6 ;this pov and delete out the severity value, if there is no V ASTHMA then quit
+7 ;as there is nothing to delete
+8 IF $PIECE($GET(^AUPNVPOV(APCDI,0)),U,5)=""
Begin DoDot:1
+9 SET APCDB=0
FOR
SET APCDB=$ORDER(^AUPNVAST("AD",APCDV,APCDB))
IF APCDB'=+APCDB
QUIT
Begin DoDot:2
+10 ;bad xref
IF '$DATA(^AUPNVAST(APCDB,0))
QUIT
+11 ;not created by this pov so leave it alone
IF $PIECE(^AUPNVAST(APCDB,0),U,13)'=APCDI
QUIT
+12 SET DA=APCDB
SET DIE="^AUPNVAST("
SET DR=".04///@"
DO ^DIE
KILL DA,DR,DIE,DIU,DIV
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
QUIT
+15 ;
+16 ;now find V ASTHMA created by this V POV and edit it, if none exists, add it
+17 SET APCDB=0
SET G=0
FOR
SET APCDB=$ORDER(^AUPNVAST("AD",APCDV,APCDB))
IF APCDB'=+APCDB!(G)
QUIT
Begin DoDot:1
+18 ;bad xref
IF '$DATA(^AUPNVAST(APCDB,0))
QUIT
+19 ;not this vpov
IF $PIECE(^AUPNVAST(APCDB,0),U,13)'=APCDI
QUIT
+20 SET DA=APCDB
SET DIE="^AUPNVAST("
SET DR=".04///"_APCDX
DO ^DIE
KILL DA,DIE,DIU,DIV
+21 SET G=1
End DoDot:1
+22 ;found one, editted it, quit
IF G
QUIT
+23 ;add v asthma entry
+24 ;
ADDVAST ;
+1 KILL APCDALVR
+2 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.41 (ADD)]"
+3 SET APCDALVR("APCDPAT")=APCDDFN
+4 SET APCDALVR("APCDVSIT")=APCDV
+5 SET APCDALVR("APCDTSEV")=APCDX
+6 SET APCDALVR("APCDTPOV")="`"_APCDI
+7 DO ^APCDALVR
+8 KILL APCDALVR
+9 ;if it fails, not much I can do but it shouldn't fail
+10 QUIT
+11 ;
ASKSTG(C) ;EP - called from data entry input templates to determine whether stage should be prompted for this icd diagnosis
+1 ;C is ien of the icd9 entry
+2 IF $GET(C)=""
QUIT 0
+3 NEW A,T,H
+4 SET A=0
SET H=0
FOR
SET A=$ORDER(^APCDSTGC(A))
IF A'=+A!(H)
QUIT
Begin DoDot:1
+5 SET T=$PIECE(^APCDSTGC(A,0),U,2)
+6 IF T=""
QUIT
+7 IF '$DATA(^ATXAX(T))
QUIT
+8 ;not in this taxonomy
IF '$$ICD^ATXAPI(C,T,9)
QUIT
+9 SET H=1
+10 QUIT
End DoDot:1
+11 QUIT H
