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

PXQMAIN.m

Go to the documentation of this file. 
  1. PXQMAIN ;ISL/JVS - DEBUGGINH MAIN ROUTINE #1;8/29/96  10:32
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**4**;Aug 12, 1996
  1.  ;
  1.  ;
  1.  ;
  1. DEPEN ;--1ST OPTION
  1.  N DFN,IEN,VISIT,ANS,I,PXBCNT,PXBHIGH
  1.  ;--ASK FOR PATIENT
  1.  S DFN=$$ASKPAT^PXQUTL Q:DFN<0
  1.  ;--GET A LIST OF VISITS
  1.  S (IEN,VISIT)=$$VISITLST^PXQGVST(DFN,"","","","X") Q:IEN<0
  1.  I $G(IEN)'<1 S ^DISV(DUZ,"PXQREP3")="`"_$G(IEN)
  1.  ;--OPEN DEVICE
  1.  S OPTION=1
  1.  D ZIS^PXQZIS G:POP EXIT
  1.  ;--RESET $X,$Y TO ZERO
  1.  N DX,DY S (DX,DY)=0 X ^%ZOSF("XY")
  1. DEP ;--TITLE OF PRINT OUT
  1.  W $$RE^PXQUTL("**  D E P E N D E N T   E N T R Y   C O U N T  **")
  1.  ;--ENTRIES POINTING TO VISIT
  1.  W $$EXP^PXQUTL("^AUPNVSIT(",IEN)
  1.  W $$RE^PXQUTL("     DEPENDENT ENTRY COUNT --- FOR     VISIT "_IEN)
  1.  W $$DEC^PXQFV(IEN,1,"")
  1.  ;--ENTRIES POINTING TO ENCOUNTER
  1.  N I S I=0 F  S I=$O(^SCE("AVSIT",IEN,I)) Q:I=""  D
  1.  .W $$RE^PXQUTL("     DEPENDENT ENTRY COUNT --- FOR ENCOUNTER "_I)
  1.  .W $$DEC^PXQFE(I,1,"")
  1.  ;--READ TO DEVICE
  1.  D READ^PXQUTL
  1.  ;--CLOSE DEVICE
  1.  D ^%ZISC
  1.  I $D(ZTSK) G EXIT
  1.  E  G DEPEN
  1.  Q
  1.  ;
  1.  ;
  1. EXPAND ;--2ND OPTION
  1.  N DFN,IEN,VISIT,ANS,I,PXBCNT,PXBHIGH,POP
  1.  ;--ASK FOR PATIENT
  1.  S DFN=$$ASKPAT^PXQUTL Q:DFN<0
  1.  ;--GET A LIST OF VISITS
  1.  S (IEN,VISIT)=$$VISITLST^PXQGVST(DFN,"","","","X") Q:IEN<0
  1.  I $G(IEN)'<1 S ^DISV(DUZ,"PXQREP3")="`"_$G(IEN)
  1.  ;--OPEN DEVICE
  1.  S OPTION=2
  1.  D ZIS^PXQZIS G:POP EXIT
  1.  ;--RESET $X,$Y TO ZERO
  1.  N DX,DY S (DX,DY)=0 X ^%ZOSF("XY")
  1. EXP ;--TITLE OF PRINT OUT
  1.  W $$RE^PXQUTL("**  E X P A N D E D  D E P E N D E N T   E N T R Y   C O U N T  **")
  1.  ;--ENTRIES POINTING TO VISIT
  1.  W $$RE^PXQUTL("     DEPENDENT ENTRY COUNT---FOR VISIT "_IEN_"-----")
  1.  W $$DEC^PXQFV(IEN,1,1)
  1.  ;--ENTRIES POINTING TO ENCOUNTER
  1.  N I S I=0 F  S I=$O(^SCE("AVSIT",IEN,I)) Q:I=""  D
  1.  .W $$RE^PXQUTL("     DEPENDENT ENTRY COUNT ---FOR ENCOUNTER "_I_"-----")
  1.  .W $$DEC^PXQFE(I,1,1)
  1.  ;--LOOK UP SCHEDULING VISITS FILE
  1.  D SDV^PXQUTL
  1.  ;--READ TO DEVICE
  1.  D READ^PXQUTL
  1.  ;--CLOSE DEVICE
  1.  D ^%ZISC
  1.  ;--RETURN TO MENU
  1.  I $D(ZTSK) G EXIT
  1.  E  G EXPAND
  1.  Q
  1.  ;
  1.  ;
  1. INTER ;--3RD OPTION
  1.  N DFN,IEN,VISIT,ANS,I,PXQINT,PXBCNT,PXBHIGH,POP
  1.  ;--SET FLAG VARIABLE
  1.  S PXQINT=1
  1.  ;--ASK FOR PATIENT
  1.  S DFN=$$ASKPAT^PXQUTL Q:DFN<0
  1.  ;--GET A LIST OF VISITS
  1.  S (IEN,VISIT)=$$VISITLST^PXQGVST(DFN,"","","","X") Q:IEN<0
  1.  I $G(IEN)'<1 S ^DISV(DUZ,"PXQREP3")="`"_$G(IEN)
  1.  ;--OPEN DEVICE
  1.  S OPTION=3
  1.  D ZIS^PXQZIS G:POP EXIT
  1.  ;--RESET $X,$Y TO ZERO
  1.  N DX,DY S (DX,DY)=0 X ^%ZOSF("XY")
  1. INT ;--TITLE OF PRINT OUT
  1.  W $$RE^PXQUTL("**  E X P A N D E D   D E P E N D E N T   E N T R Y   C O U N T  **")
  1.  ;--ENTRIES POINTING TO VISIT
  1.  W $$RE^PXQUTL("     DEPENDENT ENTRY COUNT---FOR VISIT "_IEN_"-----")
  1.  W $$DEC^PXQFV(IEN,1,1)
  1.  ;--ENTRIES POINTING TO ENCOUNTER
  1.  N I S I=0 F  S I=$O(^SCE("AVSIT",IEN,I)) Q:I=""  D
  1.  .W $$RE^PXQUTL("     DEPENDENT ENTRY COUNT ---FOR ENCOUNTER "_I_"-----")
  1.  .W $$DEC^PXQFE(I,1,1)
  1.  ;--LOOK UP SCHEDULING VISITS FILE
  1.  D SDV^PXQUTL
  1.  ;--READ TO DEVICE
  1.  D READ^PXQUTL
  1.  ;--CLOSE DEVICE
  1.  D ^%ZISC
  1.  ;--RETURN TO MENU
  1.  I $D(ZTSK) G EXIT
  1.  E  G INTER
  1.  Q
  1.  ;
  1.  ;
  1. SOURCE ;--4TH OPTION
  1.  N DFN,IEN,VISIT,ANS,I,PXQAUDIT,PXQSOR,PXBCNT,PXBHIGH,POP
  1.  ;--SET FLAG VARIABLES
  1.  S PXQAUDIT=1,PXQSOR=1
  1.  ;--ASK FOR PATIENT
  1.  S DFN=$$ASKPAT^PXQUTL Q:DFN<0
  1.  ;--GET A LIST OF VISITS
  1.  S (IEN,VISIT)=$$VISITLST^PXQGVST(DFN,"","","","X") Q:IEN<0
  1.  I $G(IEN)'<1 S ^DISV(DUZ,"PXQREP3")="`"_$G(IEN)
  1.  ;--OPEN DEVICE
  1.  S OPTION=4
  1.  D ZIS^PXQZIS G:POP EXIT
  1.  ;--RESET $X,$Y TO ZERO
  1.  N DX,DY S (DX,DY)=0 X ^%ZOSF("XY")
  1. SOR ;--TITLE OF PRINT OUT
  1.  W $$RE^PXQUTL("**  S O U R C E S / A U D I T  T R A I L  **")
  1.  ;--GET SOURCE OF THE VISIT ENTRY
  1.  W $$SOR^PXQUTL(VISIT)
  1.  ;--ENTRIES POINTING TO VISIT
  1.  W $$RE^PXQUTL("     DEPENDENT ENTRY COUNT---FOR VISIT "_IEN)
  1.  W $$DEC^PXQFV(IEN,1,1)
  1.  ;--ENTRIES POINTING TO ENCOUNTER
  1.  ;N I S I=0 F  S I=$O(^SCE("AVSIT",IEN,I)) Q:I=""  D
  1.  ;.W $$RE^PXQUTL("     DEPENDENT ENTRY COUNT ---FOR ENCOUNTER "_I)
  1.  ;.W $$DEC^PXQFE(I,1,1)
  1.  ;--READ TO DEVICE
  1.  D READ^PXQUTL
  1.  ;--CLOSE DEVICE
  1.  D ^%ZISC
  1.  I $D(ZTSK) G EXIT
  1.  ;--RETURN TO MENU
  1.  E  K USER,OPTION,PROTOCOL,SOURCE,PACKAGE,DATEC,DATEE G SOURCE
  1.  Q
  1.  ;
  1.  ;
  1. VISIT ;--5TH OPTION
  1.  ;D ^PXQRENO
  1.  ;I IOST["C-" R !,"Press any key to return to the menu",ANS:DTIME
  1.  Q
  1. CLOSE ;--CLOSE DEVICE
  1.  D ^%ZISC
  1.  ;--RETURN TO MENU
  1.  Q
  1.  ;
  1. MAX ;--MAXIMUM LENGTH OF GLOBAL REFERENCE
  1.  W !,"    I M F O R M A T I O N    O N L Y"
  1.  W !,"This routine can only be run buy someone who is"
  1.  W !,"AUTHORIZED to be in progammer mode. If you run"
  1.  W !,"the routine, 'D ^PXQGRLT' ,it will error out when"
  1.  W !,"the mazimum length is reached."
  1.  ;--RETURN TO MENU
  1.  R !,"Press any key to return to the menu",ANS:DTIME
  1.  Q
  1.  ;
  1. SETUP ;--7TH OPTION
  1.  N POP,DIC,DA
  1.  ;--TITLE OF PRINT OUT
  1.  W $$RE^PXQUTL("**  P A R A M E T E R S   S E T   U P  **")
  1.  ;--OPEN DEVICE
  1.  S OPTION=7
  1.  D ZIS^PXQZIS G:POP EXIT
  1.  ;--RESET $X,$Y TO ZERO
  1.  N DX,DY S (DX,DY)=0 X ^%ZOSF("XY")
  1. SET7 ;---START
  1.  D CHK^PXQFS
  1.  W $$EXP^PXQUTL("^DIC(",150.9)
  1.  S DIC="^DIC(150.9,",DA=1 D EN^DIQ
  1.  W $$EXP^PXQUTL("^PX(",815)
  1.  S DIC="^PX(815,",DA=1 D EN^DIQ
  1.  D READ^PXQUTL
  1.  ;--CLOSE DEVICE
  1.  D ^%ZISC
  1.  I $D(ZTSK) G EXIT
  1.  E  Q
  1.  ;---SUB ROUTINES AND FUNCTIONS
  1. EXIT ;
  1.  K USER,OPTION,PROTOCOL,SOURCE,PACKAGE,DATEC,DATEE
  1.  K OPTION
  1.  Q