APCDSTGC.m

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