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