- 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
