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

PXTTINQ.m

Go to the documentation of this file.
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