AUPNVDXQ ; IHS/CMI/LAB - SETS "AQ" XREF FOR V DIAGNOSTIC PROCEDURE 24-MAY-1993 ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;MODIFIED FOR PATCH 2 TO SUPPORT AQ CROSS REFERENCES OHPRD/JCM 010195
AQKILL1 ; ENTRY POINT FROM V DX PROCEDURE DD .01 FIELD TO KILL "AQ" XREF
N AUPNKKK S AUPNKKK=""
AQ1 ; ENTRY POINT FROM V DX PROCEDURE DD .01 FIELD TO SET "AQ" XREF
I X="" Q
I DUZ("AG")="V",'$P($G(^AUPNVDXP(DA,0)),U,7) Q ;IHS/OHPRD/JCM 8/8/94
N A,B,C,%,E,F S (A,F)=X
K:$D(AUPNKKK) ^AUPNVDXP("AQ",(X_";"),DA) ;IHS/OHPRD/JCM 8/8/94
S X=$P($G(^AUPNVDXP(DA,0)),U,4) I X="" S X=F S:'$D(AUPNKKK) ^AUPNVDXP("AQ",(X_";"),DA)="" Q ;IHS/OHPRD/JCM 8/8/94
D AQEN S X=F
Q
;
AQKILL ; ENTRY POINT TO KILL V DX PROCEDURE "AQ" XREF FROM .04 FIELD
N AUPNKKK S AUPNKKK=""
AQ ; ENTRY POINT TO SET V DX PROCEDURE "AQ" XREF FROM .04 FIELD
I X="" Q
I DUZ("AG")="V",'$P($G(^AUPNVDXP(DA,0)),U,7) Q ;IHS/OHPRD/JCM 8/8/94
N A,B,C,%,E
S %=$D(^AUPNVDXP(DA,0)) Q:'% S %=^(0)
S A=+% I 'A Q
K:'$D(AUPNKKK) ^AUPNVDXP("AQ",$P(^AUPNVDXP(DA,0),U)_";",DA) ;IHS/OHPRD/JCM 8/8/94
S:$D(AUPNKKK) ^AUPNVDXP("AQ",$P(^AUPNVDXP(DA,0),U)_";",DA)="" ;IHS/OHPRD/JCM 8/8/94
AQEN S B=$G(AUPNDXTP) I B="" Q
I B="S"!(B="G")!(B="L") S C=X D AQSET Q
I "><"[$E(X) S X=$E(X,2,99)
D @("AQ"_B)
Q
;
AQZ I "nN"[$E(X) S C=0 D AQSET Q
I "tT"[$E(X) S C=1 D AQSET Q
I $E(X,1,2)?1N1"+" S C=+X I X,X<5 S C=X+1 D AQSET Q
Q
;
AQSET S %=A_";"_C
I $D(AUPNKKK) K ^AUPNVDXP("AQ",%,DA) Q
S ^AUPNVDXP("AQ",%,DA)=""
Q
;
AQT I "nN"[$E(X) S C="000000000" D AQSET Q
I "pP"[$E(X) S C="000000001" D AQSET Q
I $E(X,1,2)="1:" S C=+$P(X,":",2) I C S E="000000000" D AQPAD,AQSET Q
Q
;
AQN S C=+X I C S E="0000" D AQPAD,AQSET
Q
;
AQQ S C=("Nn"'[$E(X))
D AQSET
Q
;
AQPAD S %=$P(C,"."),%=$E(E,1,$L(E)-$L(%))_%
I $P(C,".",2) S %=%_"."
S C=%_$P(C,".",2)
Q
;
STUFF ; SETS V DX PROCEDURE "AQ" XREF WITHOUT CALLING FILEMAN
K ^AUPNVDXP("AQ")
F DA=0:0 S DA=$O(^AUPNVDXP(DA)) Q:'DA S X=$G(^(DA,0)),AUPNDXR=+X,X=$P(X,U,4) I X'="",AUPNDXR S AUPNDXTP=$P($G(^AUTTDXPR(AUPNDXR,0)),U,2) I AUPNDXTP'="" D AQ W *13,DA
K AUPNDXTP,AUPNVDXR
Q
;
AUPNVDXQ ; IHS/CMI/LAB - SETS "AQ" XREF FOR V DIAGNOSTIC PROCEDURE 24-MAY-1993 ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;MODIFIED FOR PATCH 2 TO SUPPORT AQ CROSS REFERENCES OHPRD/JCM 010195
AQKILL1 ; ENTRY POINT FROM V DX PROCEDURE DD .01 FIELD TO KILL "AQ" XREF
+1 NEW AUPNKKK
SET AUPNKKK=""
AQ1 ; ENTRY POINT FROM V DX PROCEDURE DD .01 FIELD TO SET "AQ" XREF
+1 IF X=""
QUIT
+2 ;IHS/OHPRD/JCM 8/8/94
IF DUZ("AG")="V"
IF '$PIECE($GET(^AUPNVDXP(DA,0)),U,7)
QUIT
+3 NEW A,B,C,%,E,F
SET (A,F)=X
+4 ;IHS/OHPRD/JCM 8/8/94
IF $DATA(AUPNKKK)
KILL ^AUPNVDXP("AQ",(X_";"),DA)
+5 ;IHS/OHPRD/JCM 8/8/94
SET X=$PIECE($GET(^AUPNVDXP(DA,0)),U,4)
IF X=""
SET X=F
IF '$DATA(AUPNKKK)
SET ^AUPNVDXP("AQ",(X_";"),DA)=""
QUIT
+6 DO AQEN
SET X=F
+7 QUIT
+8 ;
AQKILL ; ENTRY POINT TO KILL V DX PROCEDURE "AQ" XREF FROM .04 FIELD
+1 NEW AUPNKKK
SET AUPNKKK=""
AQ ; ENTRY POINT TO SET V DX PROCEDURE "AQ" XREF FROM .04 FIELD
+1 IF X=""
QUIT
+2 ;IHS/OHPRD/JCM 8/8/94
IF DUZ("AG")="V"
IF '$PIECE($GET(^AUPNVDXP(DA,0)),U,7)
QUIT
+3 NEW A,B,C,%,E
+4 SET %=$DATA(^AUPNVDXP(DA,0))
IF '%
QUIT
SET %=^(0)
+5 SET A=+%
IF 'A
QUIT
+6 ;IHS/OHPRD/JCM 8/8/94
IF '$DATA(AUPNKKK)
KILL ^AUPNVDXP("AQ",$PIECE(^AUPNVDXP(DA,0),U)_";",DA)
+7 ;IHS/OHPRD/JCM 8/8/94
IF $DATA(AUPNKKK)
SET ^AUPNVDXP("AQ",$PIECE(^AUPNVDXP(DA,0),U)_";",DA)=""
AQEN SET B=$GET(AUPNDXTP)
IF B=""
QUIT
+1 IF B="S"!(B="G")!(B="L")
SET C=X
DO AQSET
QUIT
+2 IF "><"[$EXTRACT(X)
SET X=$EXTRACT(X,2,99)
+3 DO @("AQ"_B)
+4 QUIT
+5 ;
AQZ IF "nN"[$EXTRACT(X)
SET C=0
DO AQSET
QUIT
+1 IF "tT"[$EXTRACT(X)
SET C=1
DO AQSET
QUIT
+2 IF $EXTRACT(X,1,2)?1N1"+"
SET C=+X
IF X
IF X<5
SET C=X+1
DO AQSET
QUIT
+3 QUIT
+4 ;
AQSET SET %=A_";"_C
+1 IF $DATA(AUPNKKK)
KILL ^AUPNVDXP("AQ",%,DA)
QUIT
+2 SET ^AUPNVDXP("AQ",%,DA)=""
+3 QUIT
+4 ;
AQT IF "nN"[$EXTRACT(X)
SET C="000000000"
DO AQSET
QUIT
+1 IF "pP"[$EXTRACT(X)
SET C="000000001"
DO AQSET
QUIT
+2 IF $EXTRACT(X,1,2)="1:"
SET C=+$PIECE(X,":",2)
IF C
SET E="000000000"
DO AQPAD
DO AQSET
QUIT
+3 QUIT
+4 ;
AQN SET C=+X
IF C
SET E="0000"
DO AQPAD
DO AQSET
+1 QUIT
+2 ;
AQQ SET C=("Nn"'[$EXTRACT(X))
+1 DO AQSET
+2 QUIT
+3 ;
AQPAD SET %=$PIECE(C,".")
SET %=$EXTRACT(E,1,$LENGTH(E)-$LENGTH(%))_%
+1 IF $PIECE(C,".",2)
SET %=%_"."
+2 SET C=%_$PIECE(C,".",2)
+3 QUIT
+4 ;
STUFF ; SETS V DX PROCEDURE "AQ" XREF WITHOUT CALLING FILEMAN
+1 KILL ^AUPNVDXP("AQ")
+2 FOR DA=0:0
SET DA=$ORDER(^AUPNVDXP(DA))
IF 'DA
QUIT
SET X=$GET(^(DA,0))
SET AUPNDXR=+X
SET X=$PIECE(X,U,4)
IF X'=""
IF AUPNDXR
SET AUPNDXTP=$PIECE($GET(^AUTTDXPR(AUPNDXR,0)),U,2)
IF AUPNDXTP'=""
DO AQ
WRITE *13,DA
+3 KILL AUPNDXTP,AUPNVDXR
+4 QUIT
+5 ;
