VAQLED09 ;ALB/JFP - PDX, LOAD/EDIT, HELP MESSAGES;01MAR93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
HLPTRN1 ; -- Displays the patients by result for selection
N X
D STATPTR^VAQUTL95 ; -- set PDX status pointers
W !!,"(1) - All PDX transaction patients",!,"(2) - All PDX transaction patients (results)",!,"(3) - All PDX transaction patients (unsolicited)",!
R "Select Display Option: ",X:DTIME Q:X=""
I X="^" QUIT
I X=1 D HLPT1 QUIT
I X=2 D HLPT2 QUIT
I X=3 D HLPT3 QUIT
W " ...invalid entry"
QUIT
;
HLPT1 ; -- All PDX transaction patients
N DIC,D,DZ,VAQXRF3,TRNFLAG,SCR
S DIC="^VAT(394.61,"
S DIC(0)="C"
S DIC("W")="D IDENT^VAQLED09"
S DIC("S")="I $$FLT1^VAQLED09()"
S D="B",DZ="??"
D DQ^DICQ
K NM,SSN,BS5,^TMP("BS5",$J)
S %T="F" ; -- dic kills this variable required for dir (free text)
QUIT
;
HLPT2 ; -- All PDX transactions (vaq-rslt)
N DIC,D,DZ,VAQXRF3,TRNFLAG,SCR
S DIC="^VAT(394.61,"
S DIC("W")="D IDENT^VAQLED09"
S DIC("S")="I $$FLT2^VAQLED09()"
S DIC(0)="CM"
S D="B",DZ="??"
D DQ^DICQ
S %T="F" ; -- dic kills this variable required for dir (free text)
QUIT
;
HLPT3 ; -- All PDX transactions (vaq-unsol)
N DIC,D,DZ,VAQXRF3,TRNFLAG,SCR
S DIC="^VAT(394.61,"
S DIC("W")="D IDENT^VAQLED09"
S DIC("S")="I $$FLT3^VAQLED09()"
S DIC(0)="CM"
S D="B",DZ="??"
D DQ^DICQ
S %T="F" ; -- dic kills this variable required for dir (free text)
QUIT
IDENT ; -- Resets identifier
S VAQXRF0=$G(^VAT(394.61,Y,"QRY"))
S VAQXRF1=$P(VAQXRF0,U,1) ; -- name
S VAQXRF2=$P(VAQXRF0,U,4) ; -- pid
S:VAQXRF1="" VAQXRF1="NOT ON FILE"
S:VAQXRF2="" VAQXRF2="NOT ON FILE"
W ?15,"Name: ",VAQXRF1,?50,"Pid: ",VAQXRF2
K VAQXRF0,VAQXRF1,VAQXRF2
QUIT
;
FLT1() ; -- Filters out multiple names
; -- filters out transactions flagged as purged or exceeded life days
I $$EXPTRN^VAQUTL97(Y) Q 0
N NODE
S NODE=$G(^VAT(394.61,Y,"QRY"))
S NM=$P(NODE,U,1) ; -- name
Q:NM="" 0
S SSN=$P(NODE,U,4)
Q:SSN="" 0
S BS5=$E(NM,1,1)_$E(SSN,6,10)
;
I $D(^TMP("BS5",$J,BS5)) Q 0
S ^TMP("BS5",$J,BS5)=1
QUIT 1
;
FLT2() ; -- Filter out all but results
I $$EXPTRN^VAQUTL97(Y) Q 0
I $P($G(^VAT(394.61,Y,0)),U,2)=VAQRSLT Q 1
QUIT 0
;
FLT3() ; -- Filter out all but unsolicited
I $$EXPTRN^VAQUTL97(Y) Q 0
I $P($G(^VAT(394.61,Y,0)),U,2)=VAQUNSOL Q 1
QUIT 0
;
END ; -- End of code
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQLED09 2394 printed Nov 22, 2024@17:36:07 Page 2
VAQLED09 ;ALB/JFP - PDX, LOAD/EDIT, HELP MESSAGES;01MAR93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
HLPTRN1 ; -- Displays the patients by result for selection
+1 NEW X
+2 ; -- set PDX status pointers
DO STATPTR^VAQUTL95
+3 WRITE !!,"(1) - All PDX transaction patients",!,"(2) - All PDX transaction patients (results)",!,"(3) - All PDX transaction patients (unsolicited)",!
+4 READ "Select Display Option: ",X:DTIME
if X=""
QUIT
+5 IF X="^"
QUIT
+6 IF X=1
DO HLPT1
QUIT
+7 IF X=2
DO HLPT2
QUIT
+8 IF X=3
DO HLPT3
QUIT
+9 WRITE " ...invalid entry"
+10 QUIT
+11 ;
HLPT1 ; -- All PDX transaction patients
+1 NEW DIC,D,DZ,VAQXRF3,TRNFLAG,SCR
+2 SET DIC="^VAT(394.61,"
+3 SET DIC(0)="C"
+4 SET DIC("W")="D IDENT^VAQLED09"
+5 SET DIC("S")="I $$FLT1^VAQLED09()"
+6 SET D="B"
SET DZ="??"
+7 DO DQ^DICQ
+8 KILL NM,SSN,BS5,^TMP("BS5",$JOB)
+9 ; -- dic kills this variable required for dir (free text)
SET %T="F"
+10 QUIT
+11 ;
HLPT2 ; -- All PDX transactions (vaq-rslt)
+1 NEW DIC,D,DZ,VAQXRF3,TRNFLAG,SCR
+2 SET DIC="^VAT(394.61,"
+3 SET DIC("W")="D IDENT^VAQLED09"
+4 SET DIC("S")="I $$FLT2^VAQLED09()"
+5 SET DIC(0)="CM"
+6 SET D="B"
SET DZ="??"
+7 DO DQ^DICQ
+8 ; -- dic kills this variable required for dir (free text)
SET %T="F"
+9 QUIT
+10 ;
HLPT3 ; -- All PDX transactions (vaq-unsol)
+1 NEW DIC,D,DZ,VAQXRF3,TRNFLAG,SCR
+2 SET DIC="^VAT(394.61,"
+3 SET DIC("W")="D IDENT^VAQLED09"
+4 SET DIC("S")="I $$FLT3^VAQLED09()"
+5 SET DIC(0)="CM"
+6 SET D="B"
SET DZ="??"
+7 DO DQ^DICQ
+8 ; -- dic kills this variable required for dir (free text)
SET %T="F"
+9 QUIT
IDENT ; -- Resets identifier
+1 SET VAQXRF0=$GET(^VAT(394.61,Y,"QRY"))
+2 ; -- name
SET VAQXRF1=$PIECE(VAQXRF0,U,1)
+3 ; -- pid
SET VAQXRF2=$PIECE(VAQXRF0,U,4)
+4 if VAQXRF1=""
SET VAQXRF1="NOT ON FILE"
+5 if VAQXRF2=""
SET VAQXRF2="NOT ON FILE"
+6 WRITE ?15,"Name: ",VAQXRF1,?50,"Pid: ",VAQXRF2
+7 KILL VAQXRF0,VAQXRF1,VAQXRF2
+8 QUIT
+9 ;
FLT1() ; -- Filters out multiple names
+1 ; -- filters out transactions flagged as purged or exceeded life days
+2 IF $$EXPTRN^VAQUTL97(Y)
QUIT 0
+3 NEW NODE
+4 SET NODE=$GET(^VAT(394.61,Y,"QRY"))
+5 ; -- name
SET NM=$PIECE(NODE,U,1)
+6 if NM=""
QUIT 0
+7 SET SSN=$PIECE(NODE,U,4)
+8 if SSN=""
QUIT 0
+9 SET BS5=$EXTRACT(NM,1,1)_$EXTRACT(SSN,6,10)
+10 ;
+11 IF $DATA(^TMP("BS5",$JOB,BS5))
QUIT 0
+12 SET ^TMP("BS5",$JOB,BS5)=1
+13 QUIT 1
+14 ;
FLT2() ; -- Filter out all but results
+1 IF $$EXPTRN^VAQUTL97(Y)
QUIT 0
+2 IF $PIECE($GET(^VAT(394.61,Y,0)),U,2)=VAQRSLT
QUIT 1
+3 QUIT 0
+4 ;
FLT3() ; -- Filter out all but unsolicited
+1 IF $$EXPTRN^VAQUTL97(Y)
QUIT 0
+2 IF $PIECE($GET(^VAT(394.61,Y,0)),U,2)=VAQUNSOL
QUIT 1
+3 QUIT 0
+4 ;
END ; -- End of code
+1 QUIT
