AUPNVXRF ; IHS/CMI/LAB - EDITS FOR AUPNVSIT (VISIT:9000010) 24-MAY-1993 ; 30 Sep 2010 2:13 PM
;;2.0;IHS PCC SUITE;**10**;MAY 14, 2009;Build 88
;
AST ;EP - called from cross reference on Problem file .01
I $T(EP^BATREG)]"",$$ICD^ATXCHK(X,$O(^ATXAX("B","BGP ASTHMA DXS",0)),9),$D(^BATREG(0)),$G(APCDPAT) D EP^BATREG(APCDPAT)
Q
ASTV ;EP - called from cross reference on .01 of V POV
I $T(EP^BATREG)]"",$$ICD^ATXCHK(X,$O(^ATXAX("B","BGP ASTHMA DXS",0)),9),$D(^BATREG(0)),$G(APCDPAT),$G(APCDVSIT) D EP^BATREG(APCDPAT,DA,APCDVSIT)
Q
;
ASDT01S ;EP CALLED FROM XREF ON .01 CARE PLAN
I $P(^AUPNCPL(DA,0),U,4)="" Q
NEW A
S A=0 F S A=$O(^AUPNCPL(DA,11,A)) Q:A'=+A D
.Q:$P(^AUPNCPL(DA,11,A,0),U,1)=""
.Q:$P(^AUPNCPL(DA,11,A,0),U,3)=""
.S ^AUPNCPL("ASDT",X,$P(^AUPNCPL(DA,0),U,4),(9999999-$P(^AUPNCPL(DA,11,A,0),U,3)),$P(^AUPNCPL(DA,11,A,0),U,1),DA,A)=""
.Q
Q
ASDT01K ;EP CALLED FROM XREF ON .01 CARE PLAN
I $P(^AUPNCPL(DA,0),U,4)="" Q
NEW A
S A=0 F S A=$O(^AUPNCPL(DA,11,A)) Q:A'=+A D
.Q:$P(^AUPNCPL(DA,11,A,0),U,1)=""
.Q:$P(^AUPNCPL(DA,11,A,0),U,3)=""
.K ^AUPNCPL("ASDT",X,$P(^AUPNCPL(DA,0),U,4),(9999999-$P(^AUPNCPL(DA,11,A,0),U,3)),$P(^AUPNCPL(DA,11,A,0),U,1),DA,A)
.Q
Q
ASDT04S ;EP CALLED FROM XREF ON .01 CARE PLAN
NEW A
S A=0 F S A=$O(^AUPNCPL(DA,11,A)) Q:A'=+A D
.Q:$P(^AUPNCPL(DA,11,A,0),U,1)=""
.Q:$P(^AUPNCPL(DA,11,A,0),U,3)=""
.S ^AUPNCPL("ASDT",$P(^AUPNCPL(DA,0),U,1),X,(9999999-$P(^AUPNCPL(DA,11,A,0),U,3)),$P(^AUPNCPL(DA,11,A,0),U,1),DA,A)=""
.Q
Q
ASDT04K ;EP CALLED FROM XREF ON .01 CARE PLAN
NEW A
S A=0 F S A=$O(^AUPNCPL(DA,11,A)) Q:A'=+A D
.Q:$P(^AUPNCPL(DA,11,A,0),U,1)=""
.Q:$P(^AUPNCPL(DA,11,A,0),U,3)=""
.K ^AUPNCPL("ASDT",$P(^AUPNCPL(DA,0),U,1),X,(9999999-$P(^AUPNCPL(DA,11,A,0),U,3)),$P(^AUPNCPL(DA,11,A,0),U,1),DA,A)
.Q
Q
AUPNVXRF ; IHS/CMI/LAB - EDITS FOR AUPNVSIT (VISIT:9000010) 24-MAY-1993 ; 30 Sep 2010 2:13 PM
+1 ;;2.0;IHS PCC SUITE;**10**;MAY 14, 2009;Build 88
+2 ;
AST ;EP - called from cross reference on Problem file .01
+1 IF $TEXT(EP^BATREG)]""
IF $$ICD^ATXCHK(X,$ORDER(^ATXAX("B","BGP ASTHMA DXS",0)),9)
IF $DATA(^BATREG(0))
IF $GET(APCDPAT)
DO EP^BATREG(APCDPAT)
+2 QUIT
ASTV ;EP - called from cross reference on .01 of V POV
+1 IF $TEXT(EP^BATREG)]""
IF $$ICD^ATXCHK(X,$ORDER(^ATXAX("B","BGP ASTHMA DXS",0)),9)
IF $DATA(^BATREG(0))
IF $GET(APCDPAT)
IF $GET(APCDVSIT)
DO EP^BATREG(APCDPAT,DA,APCDVSIT)
+2 QUIT
+3 ;
ASDT01S ;EP CALLED FROM XREF ON .01 CARE PLAN
+1 IF $PIECE(^AUPNCPL(DA,0),U,4)=""
QUIT
+2 NEW A
+3 SET A=0
FOR
SET A=$ORDER(^AUPNCPL(DA,11,A))
IF A'=+A
QUIT
Begin DoDot:1
+4 IF $PIECE(^AUPNCPL(DA,11,A,0),U,1)=""
QUIT
+5 IF $PIECE(^AUPNCPL(DA,11,A,0),U,3)=""
QUIT
+6 SET ^AUPNCPL("ASDT",X,$PIECE(^AUPNCPL(DA,0),U,4),(9999999-$PIECE(^AUPNCPL(DA,11,A,0),U,3)),$PIECE(^AUPNCPL(DA,11,A,0),U,1),DA,A)=""
+7 QUIT
End DoDot:1
+8 QUIT
ASDT01K ;EP CALLED FROM XREF ON .01 CARE PLAN
+1 IF $PIECE(^AUPNCPL(DA,0),U,4)=""
QUIT
+2 NEW A
+3 SET A=0
FOR
SET A=$ORDER(^AUPNCPL(DA,11,A))
IF A'=+A
QUIT
Begin DoDot:1
+4 IF $PIECE(^AUPNCPL(DA,11,A,0),U,1)=""
QUIT
+5 IF $PIECE(^AUPNCPL(DA,11,A,0),U,3)=""
QUIT
+6 KILL ^AUPNCPL("ASDT",X,$PIECE(^AUPNCPL(DA,0),U,4),(9999999-$PIECE(^AUPNCPL(DA,11,A,0),U,3)),$PIECE(^AUPNCPL(DA,11,A,0),U,1),DA,A)
+7 QUIT
End DoDot:1
+8 QUIT
ASDT04S ;EP CALLED FROM XREF ON .01 CARE PLAN
+1 NEW A
+2 SET A=0
FOR
SET A=$ORDER(^AUPNCPL(DA,11,A))
IF A'=+A
QUIT
Begin DoDot:1
+3 IF $PIECE(^AUPNCPL(DA,11,A,0),U,1)=""
QUIT
+4 IF $PIECE(^AUPNCPL(DA,11,A,0),U,3)=""
QUIT
+5 SET ^AUPNCPL("ASDT",$PIECE(^AUPNCPL(DA,0),U,1),X,(9999999-$PIECE(^AUPNCPL(DA,11,A,0),U,3)),$PIECE(^AUPNCPL(DA,11,A,0),U,1),DA,A)=""
+6 QUIT
End DoDot:1
+7 QUIT
ASDT04K ;EP CALLED FROM XREF ON .01 CARE PLAN
+1 NEW A
+2 SET A=0
FOR
SET A=$ORDER(^AUPNCPL(DA,11,A))
IF A'=+A
QUIT
Begin DoDot:1
+3 IF $PIECE(^AUPNCPL(DA,11,A,0),U,1)=""
QUIT
+4 IF $PIECE(^AUPNCPL(DA,11,A,0),U,3)=""
QUIT
+5 KILL ^AUPNCPL("ASDT",$PIECE(^AUPNCPL(DA,0),U,1),X,(9999999-$PIECE(^AUPNCPL(DA,11,A,0),U,3)),$PIECE(^AUPNCPL(DA,11,A,0),U,1),DA,A)
+6 QUIT
End DoDot:1
+7 QUIT
