Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXQUTL1

PXQUTL1.m

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