PXQUTL1 ;ISL/JVS - DEBUGGING UTILITIES ;5/1/97  08:30
 ;;1.0;PCE PATIENT CARE ENCOUNTER;**4,29,163**;Aug 12 1996
 ;
 ;
DEC(VISIT,FLENUM,VISUAL,PXQFORM) ;Test looking through DD to find fields pointing to the visit entries.
 ;Q:'$D(^AUPNVSIT(VISIT)) ""
 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
 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="",STOP="",COUNT=0
 F  S FILE=$O(VDDR(FILE)) Q:FILE=""  D
 .S SUB=0,STOP="" F  S SUB=$O(VDDR(FILE,SUB)) Q:SUB=""  Q:STOP=1  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 STOP=1
 ...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
 S UPFILE=FILE
 F  S UPFILE=$G(@DD@(UPFILE,0,"UP")) Q:UPFILE'>0  D
 .S PXQIENS=$P($G(PXQIENS),",",2,10)
 .I (FILE=8925!(PXX[19908)),PXQFORM["**" S PXQFORM=".01:.999;2.1:999999"
 .I $G(PXQIENS) D GETS^DIQ(UPFILE,PXQIENS,PXQFORM,"NE","^TMP(""PXQDATA"",$J")
 .D ADD1
 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
 ;
 ;S ^TMP("PXQADDITIONAL",$J,8925,.02)="" ;-TIU FIELDS
 ;S ^TMP("PXQADDITIONAL",$J,8925,.03)="" ;-TIU FIELDS
 ;S ^TMP("PXQADDITIONAL",$J,8925,.04)="" ;-TIU FIELDS
 ;S ^TMP("PXQADDITIONAL",$J,8925,.05)="" ;-TIU FIELDS
 ;S ^TMP("PXQADDITIONAL",$J,8925,.07)="" ;-TIU FIELDS
 ;S ^TMP("PXQADDITIONAL",$J,8925,.1)="" ;-TIU FIELDS
 ;S ^TMP("PXQADDITIONAL",$J,8925,1201)="" ;-TIU FIELDS
 ;S ^TMP("PXQADDITIONAL",$J,8925,1202)="" ;-TIU FIELDS
 ;S ^TMP("PXQADDITIONAL",$J,8925,1204)="" ;-TIU FIELDS
 ;S ^TMP("PXQADDITIONAL",$J,8925,1205)="" ;-TIU FIELDS
 ;S ^TMP("PXQADDITIONAL",$J,8925,1301)="" ;-TIU FIELDS
 ;S ^TMP("PXQADDITIONAL",$J,8925,1302)="" ;-TIU FIELDS
 ;S ^TMP("PXQADDITIONAL",$J,8925,1404)="" ;-TIU FIELDS
 ;S ^TMP("PXQADDITIONAL",$J,8925,1502)="" ;-TIU FIELDS
 ;S ^TMP("PXQADDITIONAL",$J,8925,1503)="" ;-TIU FIELDS
 ;S ^TMP("PXQADDITIONAL",$J,8925,1504)="" ;-TIU FIELDS
 ;S ^TMP("PXQADDITIONAL",$J,8925,1505)="" ;-TIU FIELDS
 Q