PXTTINQ ;ISP/LMT - PCE File Inquiry ;12/15/17 07:43
;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134
;
;
PCEINQ ; Entry Point
;
N PXEXIT,PXFILE,PXFILENUM,PXIEN,PXSTOP
;
S PXEXIT=0 ; flag to control exitting of application
S PXFILE("ED")=9999999.09
S PXFILE("EX")=9999999.15
S PXFILE("HF")=9999999.64
S PXFILE("IM")=9999999.14
S PXFILE("IC")=920.4
S PXFILE("IR")=920.5
S PXFILE("SK")=9999999.28
S PXFILE("TR")=9999999.17
;
F D Q:$G(PXEXIT)
. ;
. S PXFILE=$$SELFILE()
. I PXFILE="" S PXEXIT=1 Q
. S PXFILENUM=$G(PXFILE(PXFILE))
. I 'PXFILENUM S PXEXIT=1 Q
. ;
. S PXSTOP=0 ; flag to control stop prompting for 'Entry' and return to 'File' prompt
. F D Q:PXEXIT!(PXSTOP)
. . S PXIEN=$$SELENT(PXFILENUM)
. . I PXIEN=0 S PXSTOP=1 Q
. . I PXIEN<0 S PXEXIT=1 Q
. . ;
. . D DISP(PXFILE,PXFILENUM,PXIEN)
;
Q
;
SELFILE() ; Prompt user to select a File
;
N DIR,DIRUT,PXFILE,X,Y
;
W !
S DIR(0)="SAO^ED:EDUCATION TOPICS;EX:EXAM;HF:HEALTH FACTORS;IM:IMMUNIZATION;IC:IMM CONTRAINDICATION REASONS;IR:IMM REFUSAL REASONS;SK:SKIN TEST;TR:TREATMENT"
S DIR("A")="Select FILE: "
D ^DIR
I $D(DIRUT) Q ""
S PXFILE=$P($G(Y),U,1)
;
Q PXFILE
;
SELENT(PXFILENUM) ; Prompt user to select an entry from the file
;
N DIC,DIDIC,DINUM,DLAYGO,DTOUT,DUOUT,PXIEN,X,Y
;
W !
S DIC=PXFILENUM
S DIC(0)="AEMQ"
D ^DIC
I $D(DTOUT)!($D(DUOUT)) Q -1
I $G(Y)<0 Q 0
S PXIEN=+Y
;
Q PXIEN
;
DISP(PXFILE,PXFILENUM,PXIEN) ; Display entry
;
N DA,DIC,DIQ,DR
;
I PXFILE?1(1"ED",1"EX",1"HF") D DISPOTHR(PXFILE,PXIEN) Q
;
W !!
S DIC=$$ROOT^DILFD(PXFILENUM)
S DA=PXIEN
D EN^DIQ
;
Q
;
DISPOTHR(PXFILE,PXIEN) ; Display entry for EX, ED, and HF
;
; ZEXCEPT: IOSL
N DIR,PXEXIT,PXI,PXOUT,X,Y
;
I PXFILE="ED" D EDUINQ^PXEDUINQ(PXIEN,.PXOUT)
I PXFILE="EX" D EXINQ^PXEXINQ(PXIEN,.PXOUT)
I PXFILE="HF" D HFINQ^PXHFINQ(PXIEN,.PXOUT)
;
I '$D(IOSL) D HOME^%ZIS
S $Y=0
;
F PXI=1:1 Q:'$D(PXOUT(PXI)) D Q:$G(PXEXIT)
. ;
. I $Y+3>IOSL D Q:$G(PXEXIT)
. . W !
. . S DIR(0)="E"
. . D ^DIR
. . I $G(Y)'=1 S PXEXIT=1
. . S $Y=0
. ;
. W !,$G(PXOUT(PXI))
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXTTINQ 2195 printed Nov 22, 2024@17:41:32 Page 2
PXTTINQ ;ISP/LMT - PCE File Inquiry ;12/15/17 07:43
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134
+2 ;
+3 ;
PCEINQ ; Entry Point
+1 ;
+2 NEW PXEXIT,PXFILE,PXFILENUM,PXIEN,PXSTOP
+3 ;
+4 ; flag to control exitting of application
SET PXEXIT=0
+5 SET PXFILE("ED")=9999999.09
+6 SET PXFILE("EX")=9999999.15
+7 SET PXFILE("HF")=9999999.64
+8 SET PXFILE("IM")=9999999.14
+9 SET PXFILE("IC")=920.4
+10 SET PXFILE("IR")=920.5
+11 SET PXFILE("SK")=9999999.28
+12 SET PXFILE("TR")=9999999.17
+13 ;
+14 FOR
Begin DoDot:1
+15 ;
+16 SET PXFILE=$$SELFILE()
+17 IF PXFILE=""
SET PXEXIT=1
QUIT
+18 SET PXFILENUM=$GET(PXFILE(PXFILE))
+19 IF 'PXFILENUM
SET PXEXIT=1
QUIT
+20 ;
+21 ; flag to control stop prompting for 'Entry' and return to 'File' prompt
SET PXSTOP=0
+22 FOR
Begin DoDot:2
+23 SET PXIEN=$$SELENT(PXFILENUM)
+24 IF PXIEN=0
SET PXSTOP=1
QUIT
+25 IF PXIEN<0
SET PXEXIT=1
QUIT
+26 ;
+27 DO DISP(PXFILE,PXFILENUM,PXIEN)
End DoDot:2
if PXEXIT!(PXSTOP)
QUIT
End DoDot:1
if $GET(PXEXIT)
QUIT
+28 ;
+29 QUIT
+30 ;
SELFILE() ; Prompt user to select a File
+1 ;
+2 NEW DIR,DIRUT,PXFILE,X,Y
+3 ;
+4 WRITE !
+5 SET DIR(0)="SAO^ED:EDUCATION TOPICS;EX:EXAM;HF:HEALTH FACTORS;IM:IMMUNIZATION;IC:IMM CONTRAINDICATION REASONS;IR:IMM REFUSAL REASONS;SK:SKIN TEST;TR:TREATMENT"
+6 SET DIR("A")="Select FILE: "
+7 DO ^DIR
+8 IF $DATA(DIRUT)
QUIT ""
+9 SET PXFILE=$PIECE($GET(Y),U,1)
+10 ;
+11 QUIT PXFILE
+12 ;
SELENT(PXFILENUM) ; Prompt user to select an entry from the file
+1 ;
+2 NEW DIC,DIDIC,DINUM,DLAYGO,DTOUT,DUOUT,PXIEN,X,Y
+3 ;
+4 WRITE !
+5 SET DIC=PXFILENUM
+6 SET DIC(0)="AEMQ"
+7 DO ^DIC
+8 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT -1
+9 IF $GET(Y)<0
QUIT 0
+10 SET PXIEN=+Y
+11 ;
+12 QUIT PXIEN
+13 ;
DISP(PXFILE,PXFILENUM,PXIEN) ; Display entry
+1 ;
+2 NEW DA,DIC,DIQ,DR
+3 ;
+4 IF PXFILE?1(1"ED",1"EX",1"HF")
DO DISPOTHR(PXFILE,PXIEN)
QUIT
+5 ;
+6 WRITE !!
+7 SET DIC=$$ROOT^DILFD(PXFILENUM)
+8 SET DA=PXIEN
+9 DO EN^DIQ
+10 ;
+11 QUIT
+12 ;
DISPOTHR(PXFILE,PXIEN) ; Display entry for EX, ED, and HF
+1 ;
+2 ; ZEXCEPT: IOSL
+3 NEW DIR,PXEXIT,PXI,PXOUT,X,Y
+4 ;
+5 IF PXFILE="ED"
DO EDUINQ^PXEDUINQ(PXIEN,.PXOUT)
+6 IF PXFILE="EX"
DO EXINQ^PXEXINQ(PXIEN,.PXOUT)
+7 IF PXFILE="HF"
DO HFINQ^PXHFINQ(PXIEN,.PXOUT)
+8 ;
+9 IF '$DATA(IOSL)
DO HOME^%ZIS
+10 SET $Y=0
+11 ;
+12 FOR PXI=1:1
if '$DATA(PXOUT(PXI))
QUIT
Begin DoDot:1
+13 ;
+14 IF $Y+3>IOSL
Begin DoDot:2
+15 WRITE !
+16 SET DIR(0)="E"
+17 DO ^DIR
+18 IF $GET(Y)'=1
SET PXEXIT=1
+19 SET $Y=0
End DoDot:2
if $GET(PXEXIT)
QUIT
+20 ;
+21 WRITE !,$GET(PXOUT(PXI))
End DoDot:1
if $GET(PXEXIT)
QUIT
+22 ;
+23 QUIT
