AUPNVDXP ; IHS/CMI/LAB - CHECKS VALUES FOR AUPNVDXP (DIAGNOSTIC PROCEDURE RESULTS 9000010.21) 24-MAY-1993 ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
N %
S AUPNDXR=+^AUPNVDXP(DA,0) I 'AUPNDXR K X G EXIT
S %=$G(^AUTTDXPR(AUPNDXR,0)),AUPNDXTP=$P(%,U,2),AUPNDXPM=$P(%,U,3)
I AUPNDXTP="" K X G EXIT
I $G(AUPNDXQF)="S" D AQ^AUPNVDXQ G EXIT
I $G(AUPNDXQF)="K" D AQKILL^AUPNVDXQ G EXIT
I $G(AUPNDXQF)="S1" D AQ1^AUPNVDXQ G EXIT
I $G(AUPNDXQF)="K1" D AQKILL1^AUPNVDXQ G EXIT
I $D(AUPNDXTF) N AUPNDXVV,AUPNDXPP D PTR D:$D(AUPNDXTF) @("TR"_AUPNDXTP) G EXIT
; I $D(AUPNDXTP) D TP G EXIT
D @("IT"_AUPNDXTP)
EXIT K AUPNDXR,AUPNDXTP,AUPNDXPM,AUPNDXQF,AUPNDXTF,AUPNDXTP
Q
;
ITS ; CKECKS SET OF CODES
ITG ; CHECKS GROUP
I $G(AUPNDXPM)="" K X Q
N A S A=";"_AUPNDXPM
I A[(";"_X_":") Q
;I A[":"_X_";" S X=$P($P(A,":"_X),";",2) Q
;I A[(":"_X_";") S X=$P($P(A,":",X),";",2) Q
I A[(":"_X) D Q
.S X=$P(A,X,1)
.N L S L=$L(X,";")
.S X=$P(X,";",L)
.S X=$P(X,":",1)
K X
Q
;
ITL ; CHECKS POINTER
Q
;
ITN ; CHECKS NUMBERS
N A,B,C
I AUPNDXPM="" K X Q
S A=$P(AUPNDXPM,";"),B=$P(AUPNDXPM,";",2),C=$P(AUPNDXPM,";",3)
I (A'=+A)!(B'=+B) K X Q
I X>A!(X<B) K X
I $L($P(X,".",2))>C K X Q
Q
;
HELP ;EP - HELP MESSAGE GENERATOR
N AUPNDXDA S AUPNDXDA=DA
N DIC,DIJ,DP,B,X,Y,P,DIA,DA
N D,DC,DE,DG,DH,DI,DIP,DIE,DIEL,DIFLD,DK,DL,DM,DP,DQ,DR,DSC,DV,DU,DW,DXS,DZ,L
S IOP=0,DIC="^AUTTDXPR(",FLDS=3,BY="@NUMBER",(FR,TO)=+^AUPNVDXP(AUPNDXDA,0),DHD="@"
D EN1^DIP
Q
;
TRG ;
TRL ;
TRS ; TRIGGERS SET OF CODE RESULTS
S X=""
Q
;
TRN ; TRIGGERS NUMBERS
N A,B,C,D,% S %=AUPNDXPP
S A=$P(%,";"),B=$P(%,";",2),C=$P(%,";",3),D=$P(%,";",4)
I (A'=+A)!(B'=+B)!(C'=+C)!(D'=+D) S X="" Q
S %=AUPNDXVV,X=$S(%>C:"H*",%<D:"L*",%>A:"H",%<B:"L",1:"")
Q
;
TP ; TRIGGER PARAMS INTO PARAMS FIELD
N Z,% S %=$P($G(APCDTRQ),"~",2,9),Z=$G(AUPNDXPM)
I Z=""!(%="") S X="" Q
S X=$TR(%,"~",";")_";"_$P(AUPNDXPM,";",4)
Q
;
PTR S X="" N %
I '$G(DA) Q
S %=$G(^AUPNVDXP(DA,0))
S AUPNDXVV=$P(%,U,4),AUPNDXPP=$P(%,U,6)
I AUPNDXVV=""!(AUPNDXPP)="" K AUPNDXTF Q
AUPNVDXP ; IHS/CMI/LAB - CHECKS VALUES FOR AUPNVDXP (DIAGNOSTIC PROCEDURE RESULTS 9000010.21) 24-MAY-1993 ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 NEW %
+3 SET AUPNDXR=+^AUPNVDXP(DA,0)
IF 'AUPNDXR
KILL X
GOTO EXIT
+4 SET %=$GET(^AUTTDXPR(AUPNDXR,0))
SET AUPNDXTP=$PIECE(%,U,2)
SET AUPNDXPM=$PIECE(%,U,3)
+5 IF AUPNDXTP=""
KILL X
GOTO EXIT
+6 IF $GET(AUPNDXQF)="S"
DO AQ^AUPNVDXQ
GOTO EXIT
+7 IF $GET(AUPNDXQF)="K"
DO AQKILL^AUPNVDXQ
GOTO EXIT
+8 IF $GET(AUPNDXQF)="S1"
DO AQ1^AUPNVDXQ
GOTO EXIT
+9 IF $GET(AUPNDXQF)="K1"
DO AQKILL1^AUPNVDXQ
GOTO EXIT
+10 IF $DATA(AUPNDXTF)
NEW AUPNDXVV,AUPNDXPP
DO PTR
IF $DATA(AUPNDXTF)
DO @("TR"_AUPNDXTP)
GOTO EXIT
+11 ; I $D(AUPNDXTP) D TP G EXIT
+12 DO @("IT"_AUPNDXTP)
EXIT KILL AUPNDXR,AUPNDXTP,AUPNDXPM,AUPNDXQF,AUPNDXTF,AUPNDXTP
+1 QUIT
+2 ;
ITS ; CKECKS SET OF CODES
ITG ; CHECKS GROUP
+1 IF $GET(AUPNDXPM)=""
KILL X
QUIT
+2 NEW A
SET A=";"_AUPNDXPM
+3 IF A[(";"_X_":")
QUIT
+4 ;I A[":"_X_";" S X=$P($P(A,":"_X),";",2) Q
+5 ;I A[(":"_X_";") S X=$P($P(A,":",X),";",2) Q
+6 IF A[(":"_X)
Begin DoDot:1
+7 SET X=$PIECE(A,X,1)
+8 NEW L
SET L=$LENGTH(X,";")
+9 SET X=$PIECE(X,";",L)
+10 SET X=$PIECE(X,":",1)
End DoDot:1
QUIT
+11 KILL X
+12 QUIT
+13 ;
ITL ; CHECKS POINTER
+1 QUIT
+2 ;
ITN ; CHECKS NUMBERS
+1 NEW A,B,C
+2 IF AUPNDXPM=""
KILL X
QUIT
+3 SET A=$PIECE(AUPNDXPM,";")
SET B=$PIECE(AUPNDXPM,";",2)
SET C=$PIECE(AUPNDXPM,";",3)
+4 IF (A'=+A)!(B'=+B)
KILL X
QUIT
+5 IF X>A!(X<B)
KILL X
+6 IF $LENGTH($PIECE(X,".",2))>C
KILL X
QUIT
+7 QUIT
+8 ;
HELP ;EP - HELP MESSAGE GENERATOR
+1 NEW AUPNDXDA
SET AUPNDXDA=DA
+2 NEW DIC,DIJ,DP,B,X,Y,P,DIA,DA
+3 NEW D,DC,DE,DG,DH,DI,DIP,DIE,DIEL,DIFLD,DK,DL,DM,DP,DQ,DR,DSC,DV,DU,DW,DXS,DZ,L
+4 SET IOP=0
SET DIC="^AUTTDXPR("
SET FLDS=3
SET BY="@NUMBER"
SET (FR,TO)=+^AUPNVDXP(AUPNDXDA,0)
SET DHD="@"
+5 DO EN1^DIP
+6 QUIT
+7 ;
TRG ;
TRL ;
TRS ; TRIGGERS SET OF CODE RESULTS
+1 SET X=""
+2 QUIT
+3 ;
TRN ; TRIGGERS NUMBERS
+1 NEW A,B,C,D,%
SET %=AUPNDXPP
+2 SET A=$PIECE(%,";")
SET B=$PIECE(%,";",2)
SET C=$PIECE(%,";",3)
SET D=$PIECE(%,";",4)
+3 IF (A'=+A)!(B'=+B)!(C'=+C)!(D'=+D)
SET X=""
QUIT
+4 SET %=AUPNDXVV
SET X=$SELECT(%>C:"H*",%<D:"L*",%>A:"H",%<B:"L",1:"")
+5 QUIT
+6 ;
TP ; TRIGGER PARAMS INTO PARAMS FIELD
+1 NEW Z,%
SET %=$PIECE($GET(APCDTRQ),"~",2,9)
SET Z=$GET(AUPNDXPM)
+2 IF Z=""!(%="")
SET X=""
QUIT
+3 SET X=$TRANSLATE(%,"~",";")_";"_$PIECE(AUPNDXPM,";",4)
+4 QUIT
+5 ;
PTR SET X=""
NEW %
+1 IF '$GET(DA)
QUIT
+2 SET %=$GET(^AUPNVDXP(DA,0))
+3 SET AUPNDXVV=$PIECE(%,U,4)
SET AUPNDXPP=$PIECE(%,U,6)
+4 IF AUPNDXVV=""!(AUPNDXPP)=""
KILL AUPNDXTF
QUIT
