PXQUTL1 ;ISL/JVS - DEBUGGING UTILITIES ;May 17, 2018@09:20
;;1.0;PCE PATIENT CARE ENCOUNTER;**4,29,163,211**;Aug 12 1996;Build 454
;
DEC(VISIT,FLENUM,VISUAL,PXQFORM) ;Test looking through DD to find fields pointing to the visit entries.
Q:'$D(DUZ) ""
Q:$G(PXQFORM)=""
; VISIT =Visit ien to looked up and counted
; VISUAL =Set to 1 if you want and interactive display of what is found
; PXQFORM=The format that it is to be diplayed.
;
; Look for file and field
;
N DD,PXQKY,COUNT,FIELD,FILE,GET,PIECE,PX,REF,SNDPIECE,STOP,SUB,PXQDATA
N PXQTYPE,VAR,UPFILE,PXQVGHN,PXQFLD,PXQLIEN,PXQKY,PXQKY1,PXQKY2,PXQKY3
N PXQNFLD,PXX,PXQSKIP
K VDD,VDDN,VDDR
;
S PXQTYPE=$P(PXQFORM,"^",2),PXQFORM=$P(PXQFORM,"^",1) D:$G(PXQTYPE)="C" ADD2 D:$G(PXQTYPE)="D" MUST
S DD="^DD"
S FILE=""
F S FILE=$O(@DD@(FLENUM,0,"PT",FILE)) Q:FILE="" D
.S FIELD=""
.F S FIELD=$O(@DD@(FLENUM,0,"PT",FILE,FIELD)) Q:FIELD="" D
..I $E(FILE,1,5)=19908,FLENUM=9000010 Q
..S VDD(FILE,FIELD)=""
D EN1^PXQUTL2
D REF,QUE
K VDDN,VDDR
K ^TMP("PXQADDITIONAL",$J)
I $G(VISUAL) W !,"COUNT= "
Q COUNT
;
REF ;Look for all of the regular cross references and other
;
S FILE="" F S FILE=$O(VDD(FILE)) Q:FILE="" D
.S FIELD="" F S FIELD=$O(VDD(FILE,FIELD)) Q:FIELD="" D
..D REG
K VDD
Q
;
REG ;Look for regular cross references
;
S STOP=0
I '$D(@DD@(FILE,FIELD,1)) S VDDN(FILE,FIELD)="" Q
S SUB=0 F S SUB=$O(@DD@(FILE,FIELD,1,SUB)) Q:SUB="" D
.S GET=$G(@DD@(FILE,FIELD,1,SUB,0))
.I $P(GET,"^",3)']"" S VDDR(FILE,SUB)=FILE_"^"_FIELD_"^"_SUB S STOP=1
.E S VDDN(FILE,FIELD)=""
Q
;
QUE ;CHECK OUT CROSS REFERENCE
;
S FILE="",FIELD="",COUNT=0
F S FILE=$O(VDDR(FILE)) Q:FILE="" D
.S SUB=0 F S SUB=$O(VDDR(FILE,SUB)) Q:SUB="" S GET=$G(VDDR(FILE,SUB)) D
..S REF=$G(@DD@($P(GET,"^",1),$P(GET,"^",2),1,$P(GET,"^",3),1))
..I $P(REF,"""",1)["DA(1)" Q
..S PIECE=$P(REF," ",2)
..S SNDPIECE=$P(PIECE,"""",1,2)_""""
..S PXQVGHN=$P(PIECE,"""",1,2)_""")"
..I $D(@PXQVGHN) D
...S PX=SNDPIECE_",VISIT)"
...I $D(@PX) D
....S PXQKY=0 F S PXQKY=$O(@PX@(PXQKY)) Q:PXQKY="" S COUNT=COUNT+1,PXB=PXQKY S:FILE=409.68 PXQENC(PXQKY)="" D
.....S VAR="" S VAR=$O(@PX@(PXQKY,VAR)) I VAR="" D DIS S PX=PXX Q
.....S PXQKY1=0 F S PXQKY1=$O(@PX@(PXQKY,PXQKY1)) Q:PXQKY1="" S PXB1=PXQKY1 D
......S VAR="" S VAR=$O(@PX@(PXQKY,PXQKY1,VAR)) I VAR="" D DIS S PX=PXX Q
......S PXQKY2=0 F S PXQKY2=$O(@PX@(PXQKY,PXQKY1,PXQKY2)) Q:PXQKY2="" S PXB2=PXQKY2 D
.......S VAR="" S VAR=$O(@PX@(PXQKY,PXQKY1,PXQKY2,VAR)) I VAR="" D DIS S PX=PXX Q
.......S PXQKY3=0 F S PXQKY3=$O(@PX@(PXQKY,PXQKY1,PXQKY2,PXQKY3)) Q:PXQKY3="" S PXB3=PXQKY3 D
........S VAR="" S VAR=$O(@PX@(PXQKY,PXQKY1,PXQKY2,PXQKY3,VAR)) I VAR="" D DIS S PX=PXX Q
Q
;
DIS ;--DISPLAY
;
S PXX=PX
W:$G(VISUAL) !," ",SNDPIECE_","_VISIT_","_$G(PXB) S PXBIEN=$G(PXB)
W:$G(VISUAL) $S($G(PXB1):","_$G(PXB1),1:"") S PXBIEN=PXBIEN_","_$G(PXB1)
W:$G(VISUAL) $S($G(PXB2):","_$G(PXB2),1:"") S PXBIEN=PXBIEN_","_$G(PXB2)
W:$G(VISUAL) $S($G(PXB3):","_$G(PXB3),1:"") S PXBIEN=PXBIEN_","_$G(PXB3)
K ^TMP("PXQDATA",$J)
;
;--REVERSE ORDER OF PXBIEN
S PXQIENS="" F PXQI=($L(PXBIEN,",")-1):-1:1 S PXQJ=+$P($G(PXBIEN),",",PXQI) D
.I PXQJ>0 S PXQIENS=PXQIENS_PXQJ_","
K PXBIEN
;
;--DO FIRST CALL TO GETS^DIQ
S PXQFORM2=PXQFORM
I FILE=8925,PXQFORM["**" S PXQFORM=".01:.999;2.1:999999"
I $G(PXQIENS) D GETS^DIQ(FILE,PXQIENS,PXQFORM,"NE","^TMP(""PXQDATA"",$J")
D ADD
;
;--GET NEXT FILE NUMBER
I '$D(PXQSKIP(FILE)) D
.S UPFILE=FILE
.F S UPFILE=$G(@DD@(UPFILE,0,"UP")) Q:UPFILE'>0 D
..S PXQIENS=$P($G(PXQIENS),",",2,10)
..I PXQFORM["**" D
...I (FILE=8925!(PXX[19908)) S PXQFORM=".01:.999;2.1:999999"
...I UPFILE=790 S PXQFORM=".01;.1;.29"
..I $G(PXQIENS) D GETS^DIQ(UPFILE,PXQIENS,PXQFORM,"NE","^TMP(""PXQDATA"",$J")
..D ADD1
.S PXQSKIP(FILE)=""
S PXQFORM=PXQFORM2
;
D PRINT
EXIT ;---CLEAN UP AND QUIT DOESN'T QUIT THE ROUTINE
K PXB,PXB1,PXB2,PXB3,PXQI,PXQJ
K PXQIENS,PXQTEST,PXQWORD
S VAR=""
Q
;
PRINT ;--PRINT TO SCREEN
;
N PXQFILE,PXQIENS,PXQFIELD,PXQLEIN,PXQNAME,PXQSPAC,PXQENTRY,PXQENTR
N PXQX
S PXQLIEN=0
S PXQFILE="" F S PXQFILE=$O(^TMP("PXQDATA",$J,PXQFILE)) Q:PXQFILE="" D
.S PXQNAME=$O(@DD@(PXQFILE,0,"NM",""))
.S PXQSPAC="?"_(PXQLIEN+4)_","
.S PXQTEST=PXQSPAC_""""_"FILE = "_PXQNAME_" #"_PXQFILE
.S PXQIENS="" F S PXQIENS=$O(^TMP("PXQDATA",$J,PXQFILE,PXQIENS)) Q:PXQIENS="" D
..S PXQLIEN=($L(PXQIENS,",")*4)
..S PXQENTRY=$P(PXQIENS,",",1) ;--($L(PXQIENS,",")-1))
..S PXQENTR=" RECORD #"_PXQENTRY
..W $$RE^PXQUTL(""_PXQTEST_PXQENTR_"""")
..S PXQFIELD="" F S PXQFIELD=$O(^TMP("PXQDATA",$J,PXQFILE,PXQIENS,PXQFIELD)) Q:PXQFIELD="" D
...;---NEW CODE 3/24/97
...D FIELD^DID(PXQFILE,PXQFIELD,"","TYPE","PXQWORD","PXQWORD")
...I PXQWORD("TYPE")["WORD-PROCESSING" D
....K PXQWORD,^TMP("PXQDATA",$J,PXQFILE,PXQIENS,PXQFIELD)
....S ^TMP("PXQDATA",$J,PXQFILE,PXQIENS,PXQFIELD,"E")="(word-processing field)"
...S PXQX=$G(^TMP("PXQDATA",$J,PXQFILE,PXQIENS,PXQFIELD,"E"))
...I PXQX["""" S PXQX="(not displayable-look up entry)"
...S ^TMP("PXQDATA",$J,PXQFILE,PXQIENS,PXQFIELD,"E")=PXQX
...;---END OF CODE
...N PXQNF,PXQMOV
...S PXQMOV=""",?35,"""
...S PXQNF=$P($G(@DD@(PXQFILE,PXQFIELD,0)),"^",1)_PXQMOV_" = "_$G(^TMP("PXQDATA",$J,PXQFILE,PXQIENS,PXQFIELD,"E"))
...W $$RE^PXQUTL(""_"?"_PXQLIEN_","_""""_PXQNF_"""")
W $$RE^PXQUTL("______________________________________________________________")
Q
;
ADD ;--GET FIELD VALUES FOR FILE
;
I $D(^TMP("PXQADDITIONAL",$J,FILE)) D
.S PXQNFLD=0 F S PXQNFLD=$O(^TMP("PXQADDITIONAL",$J,FILE,PXQNFLD)) Q:PXQNFLD="" D
..I $G(PXQIENS) D GETS^DIQ(FILE,PXQIENS,PXQNFLD,"E","^TMP(""PXQDATA"",$J,")
Q
;
ADD1 ;--GET FIELD VALUES FOR UPFILE
;
I $D(^TMP("PXQADDITIONAL",$J,UPFILE)) D
.S PXQNFLD=0 F S PXQNFLD=$O(^TMP("PXQADDITIONAL",$J,UPFILE,PXQNFLD)) Q:PXQNFLD="" D
..I $G(PXQIENS) D GETS^DIQ(UPFILE,PXQIENS,PXQNFLD,"E","^TMP(""PXQDATA"",$J,")
Q
;
ADD2 ;--ADDITIONAL FIELDS IN A FILE TO BE DIAPLAYED
;--LOCATE DUZ ENTRY
; VARIABLES:
; PXQUSER = Entry in file #812 representing the DUZ
; PXQFLE = File Number
; PXQFLEIE= File Number IEN in file #812
; PXQFLD = The Field in the above file
;
N PXQUSER,PXQFLE,PXQFLEIE,PXQFLD
S PXQUSER=$O(^PXD(812,"B",DUZ,0)) I PXQUSER="" Q
;--LOCATE FILE NUMBERS
S PXQFLE=0 F S PXQFLE=$O(^PXD(812,PXQUSER,"FILE","B",PXQFLE)) Q:PXQFLE="" D
.S PXQFLEIE=0 F S PXQFLEIE=$O(^PXD(812,PXQUSER,"FILE","B",PXQFLE,PXQFLEIE)) Q:PXQFLEIE="" D
..S PXQFLD=0 F S PXQFLD=$O(^PXD(812,PXQUSER,"FILE",PXQFLEIE,"FIELD","B",PXQFLD)) Q:PXQFLD="" D
...S ^TMP("PXQADDITIONAL",$J,PXQFLE,PXQFLD)=""
;
MUST ;--MUST ADDITIONAL ENTRIES TO MAKE SENSE
S ^TMP("PXQADDITIONAL",$J,9000010.18,.16)="" ;-QUANTITY -V CPT
S ^TMP("PXQADDITIONAL",$J,409.51,21)="" ;-CPT CODES - SCHEDULING VISITS
S ^TMP("PXQADDITIONAL",$J,409.51,22)="" ; " "
S ^TMP("PXQADDITIONAL",$J,409.51,23)="" ; " "
S ^TMP("PXQADDITIONAL",$J,409.51,24)="" ; " "
S ^TMP("PXQADDITIONAL",$J,409.51,25)="" ; " "
S ^TMP("PXQADDITIONAL",$J,409.68,.04)="" ;-LOCATION - ENCOUNTER
S ^TMP("PXQADDITIONAL",$J,409.68,.08)="" ;-ORIGINATING - ENCOUNTER
S ^TMP("PXQADDITIONAL",$J,9000010,.22)="" ;-VISIT - LOCATION
S ^TMP("PXQADDITIONAL",$J,9000010,.05)="" ;-VISIT - PATIENT
S ^TMP("PXQADDITIONAL",$J,70.02,3)="" ;-REGISTERED EXAMS - DIVISION
S ^TMP("PXQADDITIONAL",$J,70.02,4)="" ;-REGISTERED EXAMS - LOCATION
S ^TMP("PXQADDITIONAL",$J,70.02,5)="" ;-REGISTERED EXAMS - EXAM SET
S ^TMP("PXQADDITIONAL",$J,70.03,2)="" ;-EXAMINATIONS - PROCEDURE
S ^TMP("PXQADDITIONAL",$J,70.03,3)="" ;-EXAMINATIONS - EXAM STATUS
S ^TMP("PXQADDITIONAL",$J,70.03,4)="" ;-EXAMINATIONS - CATEGORY
S ^TMP("PXQADDITIONAL",$J,70.03,23)="" ;-EXAMINATIONS - CLINIC STOP REC
S ^TMP("PXQADDITIONAL",$J,70.03,26)="" ;-EXAMINATIONS - CREDIT METHOD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXQUTL1 8016 printed Apr 09, 2024@21:31:50 Page 2
PXQUTL1 ;ISL/JVS - DEBUGGING UTILITIES ;May 17, 2018@09:20
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**4,29,163,211**;Aug 12 1996;Build 454
+2 ;
DEC(VISIT,FLENUM,VISUAL,PXQFORM) ;Test looking through DD to find fields pointing to the visit entries.
+1 if '$DATA(DUZ)
QUIT ""
+2 if $GET(PXQFORM)=""
QUIT
+3 ; VISIT =Visit ien to looked up and counted
+4 ; VISUAL =Set to 1 if you want and interactive display of what is found
+5 ; PXQFORM=The format that it is to be diplayed.
+6 ;
+7 ; Look for file and field
+8 ;
+9 NEW DD,PXQKY,COUNT,FIELD,FILE,GET,PIECE,PX,REF,SNDPIECE,STOP,SUB,PXQDATA
+10 NEW PXQTYPE,VAR,UPFILE,PXQVGHN,PXQFLD,PXQLIEN,PXQKY,PXQKY1,PXQKY2,PXQKY3
+11 NEW PXQNFLD,PXX,PXQSKIP
+12 KILL VDD,VDDN,VDDR
+13 ;
+14 SET PXQTYPE=$PIECE(PXQFORM,"^",2)
SET PXQFORM=$PIECE(PXQFORM,"^",1)
if $GET(PXQTYPE)="C"
DO ADD2
if $GET(PXQTYPE)="D"
DO MUST
+15 SET DD="^DD"
+16 SET FILE=""
+17 FOR
SET FILE=$ORDER(@DD@(FLENUM,0,"PT",FILE))
if FILE=""
QUIT
Begin DoDot:1
+18 SET FIELD=""
+19 FOR
SET FIELD=$ORDER(@DD@(FLENUM,0,"PT",FILE,FIELD))
if FIELD=""
QUIT
Begin DoDot:2
+20 IF $EXTRACT(FILE,1,5)=19908
IF FLENUM=9000010
QUIT
+21 SET VDD(FILE,FIELD)=""
End DoDot:2
End DoDot:1
+22 DO EN1^PXQUTL2
+23 DO REF
DO QUE
+24 KILL VDDN,VDDR
+25 KILL ^TMP("PXQADDITIONAL",$JOB)
+26 IF $GET(VISUAL)
WRITE !,"COUNT= "
+27 QUIT COUNT
+28 ;
REF ;Look for all of the regular cross references and other
+1 ;
+2 SET FILE=""
FOR
SET FILE=$ORDER(VDD(FILE))
if FILE=""
QUIT
Begin DoDot:1
+3 SET FIELD=""
FOR
SET FIELD=$ORDER(VDD(FILE,FIELD))
if FIELD=""
QUIT
Begin DoDot:2
+4 DO REG
End DoDot:2
End DoDot:1
+5 KILL VDD
+6 QUIT
+7 ;
REG ;Look for regular cross references
+1 ;
+2 SET STOP=0
+3 IF '$DATA(@DD@(FILE,FIELD,1))
SET VDDN(FILE,FIELD)=""
QUIT
+4 SET SUB=0
FOR
SET SUB=$ORDER(@DD@(FILE,FIELD,1,SUB))
if SUB=""
QUIT
Begin DoDot:1
+5 SET GET=$GET(@DD@(FILE,FIELD,1,SUB,0))
+6 IF $PIECE(GET,"^",3)']""
SET VDDR(FILE,SUB)=FILE_"^"_FIELD_"^"_SUB
SET STOP=1
+7 IF '$TEST
SET VDDN(FILE,FIELD)=""
End DoDot:1
+8 QUIT
+9 ;
QUE ;CHECK OUT CROSS REFERENCE
+1 ;
+2 SET FILE=""
SET FIELD=""
SET COUNT=0
+3 FOR
SET FILE=$ORDER(VDDR(FILE))
if FILE=""
QUIT
Begin DoDot:1
+4 SET SUB=0
FOR
SET SUB=$ORDER(VDDR(FILE,SUB))
if SUB=""
QUIT
SET GET=$GET(VDDR(FILE,SUB))
Begin DoDot:2
+5 SET REF=$GET(@DD@($PIECE(GET,"^",1),$PIECE(GET,"^",2),1,$PIECE(GET,"^",3),1))
+6 IF $PIECE(REF,"""",1)["DA(1)"
QUIT
+7 SET PIECE=$PIECE(REF," ",2)
+8 SET SNDPIECE=$PIECE(PIECE,"""",1,2)_""""
+9 SET PXQVGHN=$PIECE(PIECE,"""",1,2)_""")"
+10 IF $DATA(@PXQVGHN)
Begin DoDot:3
+11 SET PX=SNDPIECE_",VISIT)"
+12 IF $DATA(@PX)
Begin DoDot:4
+13 SET PXQKY=0
FOR
SET PXQKY=$ORDER(@PX@(PXQKY))
if PXQKY=""
QUIT
SET COUNT=COUNT+1
SET PXB=PXQKY
if FILE=409.68
SET PXQENC(PXQKY)=""
Begin DoDot:5
+14 SET VAR=""
SET VAR=$ORDER(@PX@(PXQKY,VAR))
IF VAR=""
DO DIS
SET PX=PXX
QUIT
+15 SET PXQKY1=0
FOR
SET PXQKY1=$ORDER(@PX@(PXQKY,PXQKY1))
if PXQKY1=""
QUIT
SET PXB1=PXQKY1
Begin DoDot:6
+16 SET VAR=""
SET VAR=$ORDER(@PX@(PXQKY,PXQKY1,VAR))
IF VAR=""
DO DIS
SET PX=PXX
QUIT
+17 SET PXQKY2=0
FOR
SET PXQKY2=$ORDER(@PX@(PXQKY,PXQKY1,PXQKY2))
if PXQKY2=""
QUIT
SET PXB2=PXQKY2
Begin DoDot:7
+18 SET VAR=""
SET VAR=$ORDER(@PX@(PXQKY,PXQKY1,PXQKY2,VAR))
IF VAR=""
DO DIS
SET PX=PXX
QUIT
+19 SET PXQKY3=0
FOR
SET PXQKY3=$ORDER(@PX@(PXQKY,PXQKY1,PXQKY2,PXQKY3))
if PXQKY3=""
QUIT
SET PXB3=PXQKY3
Begin DoDot:8
+20 SET VAR=""
SET VAR=$ORDER(@PX@(PXQKY,PXQKY1,PXQKY2,PXQKY3,VAR))
IF VAR=""
DO DIS
SET PX=PXX
QUIT
End DoDot:8
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
DIS ;--DISPLAY
+1 ;
+2 SET PXX=PX
+3 if $GET(VISUAL)
WRITE !," ",SNDPIECE_","_VISIT_","_$GET(PXB)
SET PXBIEN=$GET(PXB)
+4 if $GET(VISUAL)
WRITE $SELECT($GET(PXB1):","_$GET(PXB1),1:"")
SET PXBIEN=PXBIEN_","_$GET(PXB1)
+5 if $GET(VISUAL)
WRITE $SELECT($GET(PXB2):","_$GET(PXB2),1:"")
SET PXBIEN=PXBIEN_","_$GET(PXB2)
+6 if $GET(VISUAL)
WRITE $SELECT($GET(PXB3):","_$GET(PXB3),1:"")
SET PXBIEN=PXBIEN_","_$GET(PXB3)
+7 KILL ^TMP("PXQDATA",$JOB)
+8 ;
+9 ;--REVERSE ORDER OF PXBIEN
+10 SET PXQIENS=""
FOR PXQI=($LENGTH(PXBIEN,",")-1):-1:1
SET PXQJ=+$PIECE($GET(PXBIEN),",",PXQI)
Begin DoDot:1
+11 IF PXQJ>0
SET PXQIENS=PXQIENS_PXQJ_","
End DoDot:1
+12 KILL PXBIEN
+13 ;
+14 ;--DO FIRST CALL TO GETS^DIQ
+15 SET PXQFORM2=PXQFORM
+16 IF FILE=8925
IF PXQFORM["**"
SET PXQFORM=".01:.999;2.1:999999"
+17 IF $GET(PXQIENS)
DO GETS^DIQ(FILE,PXQIENS,PXQFORM,"NE","^TMP(""PXQDATA"",$J")
+18 DO ADD
+19 ;
+20 ;--GET NEXT FILE NUMBER
+21 IF '$DATA(PXQSKIP(FILE))
Begin DoDot:1
+22 SET UPFILE=FILE
+23 FOR
SET UPFILE=$GET(@DD@(UPFILE,0,"UP"))
if UPFILE'>0
QUIT
Begin DoDot:2
+24 SET PXQIENS=$PIECE($GET(PXQIENS),",",2,10)
+25 IF PXQFORM["**"
Begin DoDot:3
+26 IF (FILE=8925!(PXX[19908))
SET PXQFORM=".01:.999;2.1:999999"
+27 IF UPFILE=790
SET PXQFORM=".01;.1;.29"
End DoDot:3
+28 IF $GET(PXQIENS)
DO GETS^DIQ(UPFILE,PXQIENS,PXQFORM,"NE","^TMP(""PXQDATA"",$J")
+29 DO ADD1
End DoDot:2
+30 SET PXQSKIP(FILE)=""
End DoDot:1
+31 SET PXQFORM=PXQFORM2
+32 ;
+33 DO PRINT
EXIT ;---CLEAN UP AND QUIT DOESN'T QUIT THE ROUTINE
+1 KILL PXB,PXB1,PXB2,PXB3,PXQI,PXQJ
+2 KILL PXQIENS,PXQTEST,PXQWORD
+3 SET VAR=""
+4 QUIT
+5 ;
PRINT ;--PRINT TO SCREEN
+1 ;
+2 NEW PXQFILE,PXQIENS,PXQFIELD,PXQLEIN,PXQNAME,PXQSPAC,PXQENTRY,PXQENTR
+3 NEW PXQX
+4 SET PXQLIEN=0
+5 SET PXQFILE=""
FOR
SET PXQFILE=$ORDER(^TMP("PXQDATA",$JOB,PXQFILE))
if PXQFILE=""
QUIT
Begin DoDot:1
+6 SET PXQNAME=$ORDER(@DD@(PXQFILE,0,"NM",""))
+7 SET PXQSPAC="?"_(PXQLIEN+4)_","
+8 SET PXQTEST=PXQSPAC_""""_"FILE = "_PXQNAME_" #"_PXQFILE
+9 SET PXQIENS=""
FOR
SET PXQIENS=$ORDER(^TMP("PXQDATA",$JOB,PXQFILE,PXQIENS))
if PXQIENS=""
QUIT
Begin DoDot:2
+10 SET PXQLIEN=($LENGTH(PXQIENS,",")*4)
+11 ;--($L(PXQIENS,",")-1))
SET PXQENTRY=$PIECE(PXQIENS,",",1)
+12 SET PXQENTR=" RECORD #"_PXQENTRY
+13 WRITE $$RE^PXQUTL(""_PXQTEST_PXQENTR_"""")
+14 SET PXQFIELD=""
FOR
SET PXQFIELD=$ORDER(^TMP("PXQDATA",$JOB,PXQFILE,PXQIENS,PXQFIELD))
if PXQFIELD=""
QUIT
Begin DoDot:3
+15 ;---NEW CODE 3/24/97
+16 DO FIELD^DID(PXQFILE,PXQFIELD,"","TYPE","PXQWORD","PXQWORD")
+17 IF PXQWORD("TYPE")["WORD-PROCESSING"
Begin DoDot:4
+18 KILL PXQWORD,^TMP("PXQDATA",$JOB,PXQFILE,PXQIENS,PXQFIELD)
+19 SET ^TMP("PXQDATA",$JOB,PXQFILE,PXQIENS,PXQFIELD,"E")="(word-processing field)"
End DoDot:4
+20 SET PXQX=$GET(^TMP("PXQDATA",$JOB,PXQFILE,PXQIENS,PXQFIELD,"E"))
+21 IF PXQX[""""
SET PXQX="(not displayable-look up entry)"
+22 SET ^TMP("PXQDATA",$JOB,PXQFILE,PXQIENS,PXQFIELD,"E")=PXQX
+23 ;---END OF CODE
+24 NEW PXQNF,PXQMOV
+25 SET PXQMOV=""",?35,"""
+26 SET PXQNF=$PIECE($GET(@DD@(PXQFILE,PXQFIELD,0)),"^",1)_PXQMOV_" = "_$GET(^TMP("PXQDATA",$JOB,PXQFILE,PXQIENS,PXQFIELD,"E"))
+27 WRITE $$RE^PXQUTL(""_"?"_PXQLIEN_","_""""_PXQNF_"""")
End DoDot:3
End DoDot:2
End DoDot:1
+28 WRITE $$RE^PXQUTL("______________________________________________________________")
+29 QUIT
+30 ;
ADD ;--GET FIELD VALUES FOR FILE
+1 ;
+2 IF $DATA(^TMP("PXQADDITIONAL",$JOB,FILE))
Begin DoDot:1
+3 SET PXQNFLD=0
FOR
SET PXQNFLD=$ORDER(^TMP("PXQADDITIONAL",$JOB,FILE,PXQNFLD))
if PXQNFLD=""
QUIT
Begin DoDot:2
+4 IF $GET(PXQIENS)
DO GETS^DIQ(FILE,PXQIENS,PXQNFLD,"E","^TMP(""PXQDATA"",$J,")
End DoDot:2
End DoDot:1
+5 QUIT
+6 ;
ADD1 ;--GET FIELD VALUES FOR UPFILE
+1 ;
+2 IF $DATA(^TMP("PXQADDITIONAL",$JOB,UPFILE))
Begin DoDot:1
+3 SET PXQNFLD=0
FOR
SET PXQNFLD=$ORDER(^TMP("PXQADDITIONAL",$JOB,UPFILE,PXQNFLD))
if PXQNFLD=""
QUIT
Begin DoDot:2
+4 IF $GET(PXQIENS)
DO GETS^DIQ(UPFILE,PXQIENS,PXQNFLD,"E","^TMP(""PXQDATA"",$J,")
End DoDot:2
End DoDot:1
+5 QUIT
+6 ;
ADD2 ;--ADDITIONAL FIELDS IN A FILE TO BE DIAPLAYED
+1 ;--LOCATE DUZ ENTRY
+2 ; VARIABLES:
+3 ; PXQUSER = Entry in file #812 representing the DUZ
+4 ; PXQFLE = File Number
+5 ; PXQFLEIE= File Number IEN in file #812
+6 ; PXQFLD = The Field in the above file
+7 ;
+8 NEW PXQUSER,PXQFLE,PXQFLEIE,PXQFLD
+9 SET PXQUSER=$ORDER(^PXD(812,"B",DUZ,0))
IF PXQUSER=""
QUIT
+10 ;--LOCATE FILE NUMBERS
+11 SET PXQFLE=0
FOR
SET PXQFLE=$ORDER(^PXD(812,PXQUSER,"FILE","B",PXQFLE))
if PXQFLE=""
QUIT
Begin DoDot:1
+12 SET PXQFLEIE=0
FOR
SET PXQFLEIE=$ORDER(^PXD(812,PXQUSER,"FILE","B",PXQFLE,PXQFLEIE))
if PXQFLEIE=""
QUIT
Begin DoDot:2
+13 SET PXQFLD=0
FOR
SET PXQFLD=$ORDER(^PXD(812,PXQUSER,"FILE",PXQFLEIE,"FIELD","B",PXQFLD))
if PXQFLD=""
QUIT
Begin DoDot:3
+14 SET ^TMP("PXQADDITIONAL",$JOB,PXQFLE,PXQFLD)=""
End DoDot:3
End DoDot:2
End DoDot:1
+15 ;
MUST ;--MUST ADDITIONAL ENTRIES TO MAKE SENSE
+1 ;-QUANTITY -V CPT
SET ^TMP("PXQADDITIONAL",$JOB,9000010.18,.16)=""
+2 ;-CPT CODES - SCHEDULING VISITS
SET ^TMP("PXQADDITIONAL",$JOB,409.51,21)=""
+3 ; " "
SET ^TMP("PXQADDITIONAL",$JOB,409.51,22)=""
+4 ; " "
SET ^TMP("PXQADDITIONAL",$JOB,409.51,23)=""
+5 ; " "
SET ^TMP("PXQADDITIONAL",$JOB,409.51,24)=""
+6 ; " "
SET ^TMP("PXQADDITIONAL",$JOB,409.51,25)=""
+7 ;-LOCATION - ENCOUNTER
SET ^TMP("PXQADDITIONAL",$JOB,409.68,.04)=""
+8 ;-ORIGINATING - ENCOUNTER
SET ^TMP("PXQADDITIONAL",$JOB,409.68,.08)=""
+9 ;-VISIT - LOCATION
SET ^TMP("PXQADDITIONAL",$JOB,9000010,.22)=""
+10 ;-VISIT - PATIENT
SET ^TMP("PXQADDITIONAL",$JOB,9000010,.05)=""
+11 ;-REGISTERED EXAMS - DIVISION
SET ^TMP("PXQADDITIONAL",$JOB,70.02,3)=""
+12 ;-REGISTERED EXAMS - LOCATION
SET ^TMP("PXQADDITIONAL",$JOB,70.02,4)=""
+13 ;-REGISTERED EXAMS - EXAM SET
SET ^TMP("PXQADDITIONAL",$JOB,70.02,5)=""
+14 ;-EXAMINATIONS - PROCEDURE
SET ^TMP("PXQADDITIONAL",$JOB,70.03,2)=""
+15 ;-EXAMINATIONS - EXAM STATUS
SET ^TMP("PXQADDITIONAL",$JOB,70.03,3)=""
+16 ;-EXAMINATIONS - CATEGORY
SET ^TMP("PXQADDITIONAL",$JOB,70.03,4)=""
+17 ;-EXAMINATIONS - CLINIC STOP REC
SET ^TMP("PXQADDITIONAL",$JOB,70.03,23)=""
+18 ;-EXAMINATIONS - CREDIT METHOD
SET ^TMP("PXQADDITIONAL",$JOB,70.03,26)=""
+19 QUIT
