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

PXQMAIN4.m

Go to the documentation of this file. 
  1. PXQMAIN4 ;ISL/JVS - USER FRIENDLY REPORT ;3/25/97  11:09
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**4,29**;Aug 12,1996
  1.  ;
  1. REPT ;--PCE VISIT TRAIL CUSTONIZED REPORT OPTION
  1.  N DFN,IEN,VISIT,ANS,I,PXBCNT,PXBHIGH,PXQRECI
  1.  S PXQRECI=0
  1.  ;
  1.  ;--SET UP OR RETRIEVE DEFAULTS
  1.  I '$D(^DISV(DUZ,"PXQREP1")) S ^DISV(DUZ,"PXQREP1")="P"
  1.  ;
  1. ASK ;--ASK BY PATIENT OR BY IEN
  1.  S DIR("A",1)="Enter '^' to exit"
  1.  S DIR("A")="Select by (P)atient or (I)en"
  1.  S DIR("B")=$G(^DISV(DUZ,"PXQREP1"))
  1.  S DIR(0)="SOM^P:Patient List of Visits;I:Internal Entry Number of VISIT"
  1.  D ^DIR K DIR
  1.  I Y=""!(Y["^")!(Y<0) G EXIT
  1.  I "IP"[Y S ^DISV(DUZ,"PXQREP1")=Y
  1.  I Y="I" G IEN
  1.  ;
  1. PAT ;--ASK FOR PATIENT
  1.  S DFN=$$ASKPAT^PXQUTL Q:DFN<0
  1.  ;--ASK DATE RANGE
  1.  D DATE^PXQUTL2
  1.  I '$G(PXQSTART)!('$G(PXQEND)) G PAT
  1.  ;--GET A LIST OF VISITS
  1.  S (IEN,VISIT)=$$VISITLST^PXQGVST(DFN,PXQSTART,PXQEND,"","X") K PXQSTART,PXQEND G:IEN<0 ASK
  1.  I $G(IEN)'<0 S ^DISV(DUZ,"PXQREP3")="`"_$G(IEN)
  1.  G FORM
  1. IEN ;--ASK FOR IEN OF VISIT
  1.  N DFN,IEN,VISIT,ANS,I,BROKEN
  1.  I $G(^DISV(DUZ,"PXQREP3"))]"" S DIR("B")=$G(^DISV(DUZ,"PXQREP3"))
  1.  S (VISIT,IEN)=$$ASKNUM1^PXQUTL K DIR I IEN<0 D  G:IEN<0 ASK
  1.  .I $G(IEN)]""&($G(IEN)'["^")&($G(IEN)'<0) S ^DISV(DUZ,"PXQREP3")=$G(IEN)
  1.  ;.R !,"Look at a Possible BROKER POINTER to a visit? (Y/N): N// ",ANS:DTIME
  1.  ;.I ANS["N"!(ANS="")!(ANS["^") Q
  1.  ;.R !,"Enter Visit IEN: ",ANS:DTIME
  1.  ;.I +ANS<1 G IEN
  1.  ;.S (VISIT,IEN)=ANS
  1.  ;.S ^DISV(DUZ,"PXQREP3")="`"_$G(IEN)
  1.  ;.I '$D(^AUPNVSIT(ANS)) S BROKEN=1
  1.  I $G(IEN)'<0 S ^DISV(DUZ,"PXQREP3")="`"_$G(IEN)
  1.  ;
  1.  ;
  1. FORM ;--FORMAT FO THE RPORT
  1.  S DIR("A",1)="~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
  1.  S DIR("A",2)="To Customize your display use VA Fileman to add entries in file"
  1.  S DIR("A",3)="PCE CUSTOMIZE REPORT, with your NAME, FILE/SUBFILE#s, and FIELD#s"
  1.  S DIR("A",4)="that you want to have included in the report."
  1.  S DIR("A",5)="~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
  1.  S DIR("A",6)=" "
  1.  S DIR("A",7)="Enter '^^' to exit option"
  1.  S DIR("A")="Format of Print out"
  1.  S DIR("B")=$G(^DISV(DUZ,"PXQREP2"))
  1.  S DIR(0)="SOM^D:Default (first field of each file/subfile);A:All fields in a file/subfile (except 'NULL');C:Customized by User (Default plus added fields) "
  1.  D ^DIR K DIR
  1.  I Y=""!(Y="^") G ASK
  1.  I Y="^^" G EXIT
  1.  I "CDA^^"'[Y G FORM
  1.  I "DAC"[Y S ^DISV(DUZ,"PXQREP2")=Y
  1.  I Y="D" S PXQFORM=".01"_"^"_Y
  1.  I Y="A" S PXQFORM="**"_"^"_Y
  1.  I Y="C" S PXQFORM=".01"_"^"_Y
  1.  ;
  1. OPEN ;--OPEN DEVICE
  1.  S OPTION=10
  1.  D ZIS^PXQZIS G:POP EXIT
  1.  ;
  1.  ;--RESET $X,$Y TO ZERO
  1.  N DX,DY S (DX,DY)=0 X ^%ZOSF("XY")
  1.  ;
  1. REPORT ;--DO REPORT
  1.  K ^TMP("PXQDATA",$J)
  1.  N VAR
  1.  W $$RE^PXQUTL("***  R E C O R D    O F    R E L A T E D    E N T R I E S  ***")
  1.  W $$RE^PXQUTL(" ")
  1.  W $$RE^PXQUTL("         The Following is the VISIT file entry and")
  1.  W $$RE^PXQUTL("          ALL records pointing back to this entry.")
  1.  W $$RE^PXQUTL(" ")
  1.  W $$RE^PXQUTL("               VISIT RECORD    --- #"_VISIT_"")
  1.  W $$RE^PXQUTL(" ")
  1.  I $D(^AUPNVSIT(VISIT)) D
  1.  .N PXQSTUFF,PXQPAT,PXQDT,PXQCLN
  1.  .D GETS^DIQ(9000010,VISIT_",",".01;.05;.22","EI","PXQSTUFF","PXQSTUFF")
  1.  .D GETS^DIQ(9000010,VISIT_",","**","E","^TMP(""PXQDATA"",$J,")
  1.  .S PXQDT=$G(PXQSTUFF(9000010,VISIT_",",.01,"E"))
  1.  .S PXQPAT=$G(PXQSTUFF(9000010,VISIT_",",.05,"E"))
  1.  .S PXQCLN=$G(PXQSTUFF(9000010,VISIT_",",.22,"E"))
  1.  .S DFN=$G(PXQSTUFF(9000010,VISIT_",",.05,"I"))
  1.  .W $$RE^PXQUTL("               DATE/TIME --- "_PXQDT_"")
  1.  .W $$RE^PXQUTL("               PATIENT   --- "_PXQPAT_"")
  1.  .W $$RE^PXQUTL("               LOCATION  --- "_PXQCLN_"")
  1.  .W $$RE^PXQUTL(" ")
  1.  .W $$RE^PXQUTL("______________________________________________________________")
  1.  S VAR=$$DEC^PXQUTL1(VISIT,9000010,"",PXQFORM)
  1.  I $D(PXQENC) D  K PXQENC
  1.  .N PXQII
  1.  .S PXQII=0 F  S PXQII=$O(PXQENC(PXQII)) Q:PXQII=""  D
  1.  ..W $$RE^PXQUTL(" ")
  1.  ..W $$RE^PXQUTL("       The Following is the OUTPATIENT ENCOUNTER entry and")
  1.  ..W $$RE^PXQUTL("            most of the records pointing back to it.")
  1.  ..W $$RE^PXQUTL(" ")
  1.  ..W $$RE^PXQUTL("             OUTPATIENT ENCOUNTER --- #"_PXQII_"")
  1.  ..W $$RE^PXQUTL(" ")
  1.  ..W $$RE^PXQUTL("______________________________________________________________")
  1.  ..S VAR=$$DEC^PXQUTL1(PXQII,409.68,"",PXQFORM)
  1.  W $$RE^PXQUTL(" ")
  1.  W $$RE^PXQUTL("       The Following is the SCHEDULING VISITS file.")
  1.  W $$RE^PXQUTL("      This is where Scheduling stores the CPT codes.")
  1.  W $$RE^PXQUTL(" ")
  1.  D SDV^PXQUTL
  1.  ;--READ TO DEVICE
  1.  D READ^PXQUTL
  1.  ;--CLOSE DEVICE
  1.  D ^%ZISC
  1.  I $D(ZTSK) G EXIT
  1.  E  D FORM
  1.  Q
  1.  ;
  1.  ;
  1. EXIT ;--CLEAN UP AND QUIT
  1.  K DIR,DIC,OPTION
  1.  K ^TMP("PXQDATA",$J)
  1.  Q