source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXBGVST.m@ 824

PXBGVST ;ISL/JVS - GATHER ENCOUNTERS ;8/28/96
 ;;1.0;PCE PATIENT CARE ENCOUNTER;**1**;Aug 12, 1996
 ;
 ;
 ;
VISITLST(DFN,BEGINDT,ENDDT,HLOC,SCREEN,APPOINT,PROMPT,COSTATUS) ;--GATHER VISITS
 ;
 ; DFN     = Patient Identification entry number         (required)
 ; BEGINDT = Begining date of date range-INTERNAL FORMAT (optional)
 ; ENDDT   = Ending date of date range-INTERNAL FORMAT   (optional)
 ; HLOC    = Hospital Location (pointer to file#44)      (optional)
 ; SCREEN  = Code as related to field 15003              (optional)
 ;         
 ;         ..'A'=ANCILLARY
 ;         ..'P'=PRIMARY
 ;         ..'O'=OCCASION OF SERIVCE
 ;         ..'S'=STOP CODES
 ;         ..'X'=All three above plus the 'NULL' Encounters (DEFAULT)
 ;
 ;         ..'E'=Historical Encounters ('XE' for all historical visits)
 ;
 ; APPOINT
 ;         ..-1
 ;         ..0
 ;         ..1
 ; OUTPUT:
 ; >0   = VISIT IEN
 ; =0   = User selected to add a visit
 ; -1   = No visit selected
 ; -2^"TEXT"   = error of some kind^mesage about error
 ;
 ;
 ;--Validate A PATIENT visit is sent in
 I $G(DFN)<1 Q -2_"^"_"NO PATIENT"
 I '$D(^AUPNPAT(DFN)) Q -2_"^"_"NO SUCH PATIENT"
 ;
 ;--If no date range then default it
 I BEGINDT<1500000!(ENDDT<1500000) D
 . N X1,X2,%H,%T
 . S X1=DT,X2=+$P(^PX(815,1,"LM"),"^",3) D C^%DTC S BEGINDT=$S(BEGINDT>X:BEGINDT,1:X)
 . S X1=DT,X2=+$P(^PX(815,1,"LM"),"^",4) D C^%DTC S ENDDT=X
 ;
 N STOP
 I $G(HLOC) D  Q:$G(STOP) -2_"^"_"NO SUCH HOSPITAL LOCATION"
 .I '$D(^SC(HLOC)) S STOP=1
 ;
 ;--NEW variables
 N IEN,INDATEI,INDATEE,PXBC,PXBCC,VST,PXBI,SCRN,SCRN1,ENDDTT,BEGINDTT
 N PXBHIGH,PXBCNT,PXBWIN,PXBSAVE,PXBDT,DEL,NOD0,NOD150,UID,STATUS
 N HLOCE,HLOCI,VAL,VAR
 S (PXBC,PXBCC)=0
 ;--KILL variables
 K ^TMP("PXBU",$J),^UTILITY("DIQ1",$J),^TMP("PXBKY",$J),^TMP("PXBSAM",$J),^TMP("PXBSKY",$J),GROUP
 ;--CREATE tmp global
 ;-SET UP SCREEN
 I $D(SCREEN) D
 .S PXBI="" F PXBI=1:1:$L(SCREEN) S SCRN($E(SCREEN,PXBI))=""
 .I '$D(SCRN) S SCRN("X")=""
 I $D(^AUPNVSIT("AA",DFN)) D
 .I $G(ENDDT) S ENDDTT=9999999-$P(ENDDT,".",1) S:ENDDT["." ENDDTT=ENDDTT_((ENDDT#1)-(.0001)) S:ENDDT'["." ENDDTT=(ENDDTT)-(.0001) S ENDDT=ENDDTT
 .I $G(BEGINDT) S BEGINDTT=9999999-$P(BEGINDT,".",1) S:BEGINDT["." BEGINDTT=BEGINDTT_(BEGINDT#1) S:BEGINDT'["." BEGINDTT=BEGINDTT_".999999" S BEGINDT=BEGINDTT
 .I '$G(BEGINDT) S BEGINDT=999999999
 .S PXBDT=$S($G(ENDDT):ENDDT,1:"")
 .F  S PXBDT=$O(^AUPNVSIT("AA",DFN,PXBDT)) Q:PXBDT>BEGINDT  Q:PXBDT'>0  D
 ..S IEN=0 F  S IEN=$O(^AUPNVSIT("AA",DFN,PXBDT,IEN)) Q:IEN=""  D
 ...;
 ...;-----SCREEN-------
 ...;----BRING IN ALL NODES
 ...S NOD0=$G(^AUPNVSIT(IEN,0)),NOD150=$G(^AUPNVSIT(IEN,150))
 ...;--SCREEN OUT HISTORICAL VISITS
 ...I $D(SCRN("E")),$P(NOD0,"^",7)'="E" Q
 ...I '$D(SCRN("E")),$P(NOD0,"^",7)="E" Q
 ...;--SCREEN BASED ON PARAMETER
 ...S SCRN1=$P(NOD150,"^",3)
 ...I SCRN1="",'$D(SCRN("X")) Q
 ...I $D(SCRN("X")) G CON
 ...I SCRN1="A",'$D(SCRN("A")) Q
 ...I SCRN1="O",'$D(SCRN("O")) Q
 ...I SCRN1="P",'$D(SCRN("P")) Q
 ...I SCRN1="S",'$D(SCRN("S")) Q
 ...I SCRN1="C",'$D(SCRN("C")) Q
CON ...;--CONTINUE
 ...;--HOSPITAL LOCATION
 ...I $G(HLOC) Q:$P(NOD0,"^",22)'=HLOC
 ...I $G(APPOINT)=0 G END
 ...;--I RELATED TO APPOINTMENT--APPOINT=1
 ...;I $G(APPOINT)>0,$P(NOD0,"^",22)'=+$G(^DPT(DFN,"S",$P(NOD0,"^",1),0)) Q
 ...I $G(APPOINT)>0,'$$VSTAPPT^PXUTL1(DFN,$P(NOD0,"^",1),$P(NOD0,"^",22),IEN) Q
 ...;--I NOT RELATED TO AN APPOINTMENT--APPOINT=-1
 ...;I $G(APPOINT)<0,$P(NOD0,"^",22)=+$G(^DPT(DFN,"S",$P(NOD0,"^",1),0)) Q
 ...I $G(APPOINT)<0,$$VSTAPPT^PXUTL1(DFN,$P(NOD0,"^",1),$P(NOD0,"^",22),IEN) Q
END ...;---END OF SCREENS-----
 ...;--DISPOSITIONS
 ...I $$DISPOSIT^PXUTL1(DFN,$P(NOD0,"^",1),IEN) Q 
 ...;
 ...S PXBC=PXBC+1
 ...S ^TMP("PXBU",$J,"VST",IEN)=""
 K SCRN,SCRN1
 ;
 ;
A ;--Set array with the VISITS from the visits
 N DIQ,PRIME,PRIMI,PXBDT,VSTDTE,VSTDTI,GROUP
 I $D(^TMP("PXBU",$J,"VST")) D
 .S IEN=0 F  S IEN=$O(^TMP("PXBU",$J,"VST",IEN)) Q:IEN'>0  D
 ..S DIC=9000010,DR=".01;.22;15003;15001",DA=IEN,DIQ(0)="EI" D EN^DIQ1
 ..S VSTDTE=$G(^UTILITY("DIQ1",$J,9000010,DA,.01,"E"))
 ..S VSTDTE=$P(VSTDTE,"@",1)_"   "_$P($P(VSTDTE,"@",2),":",1,2)
 ..S VSTDTI=$G(^UTILITY("DIQ1",$J,9000010,DA,.01,"I"))
 ..S HLOCE=$G(^UTILITY("DIQ1",$J,9000010,DA,.22,"E"))
 ..S HLOCI=$G(^UTILITY("DIQ1",$J,9000010,DA,.22,"I"))
 ..S PRIME=$G(^UTILITY("DIQ1",$J,9000010,DA,15003,"E"))
 ..S PRIMI=$G(^UTILITY("DIQ1",$J,9000010,DA,15003,"I"))
 ..S UID=$G(^UTILITY("DIQ1",$J,9000010,DA,15001,"E"))
 ..S STATUS=$P($$STATUS^SDPCE(IEN),"^",2)
 ..S GROUP=VSTDTE_"^"_VSTDTI_"^"_HLOCE_"^"_HLOCI_"^"_PRIME_"^"_PRIMI_"^"_UID_"^"_STATUS
 ..S ^TMP("PXBVSTG",$J,VSTDTI,IEN)=GROUP
 K DIC,DR,DA
 ;
 ;
B ;--ADD Line Numbers
 I $D(^TMP("PXBVSTG",$J)) D
 .S PXBCC=PXBC+1,VST="" F  S VST=$O(^TMP("PXBVSTG",$J,VST)) Q:VST=""  D
 ..S IEN=0 F  S IEN=$O(^TMP("PXBVSTG",$J,VST,IEN)) Q:IEN=""  S PXBCC=PXBCC-1 D
 ...S ^TMP("PXBKY",$J,VST,PXBCC)=$G(^TMP("PXBVSTG",$J,VST,IEN))
 ...S ^TMP("PXBSAM",$J,PXBCC)=$G(^TMP("PXBVSTG",$J,VST,IEN))
 ...S ^TMP("PXBSKY",$J,PXBCC,IEN)=""
 ;
F ;--FINISH UP THE VARIABLES
 K ^TMP("PXBU",$J),^UTILITY("DIQ1",$J)
 S PXBCNT=+$G(PXBC)
 D DISP
 Q VAL
 ;
 ;---GO TO PROMPTING
DISP ;--DISPLAY
 ;---------------NEW CURSOR CONTROL VARIABLE-----------------------
 N IOARM0,IOARM1,IOAWM0,IOAWM1,IOBOFF,IOBON,IOCOMMA,IOCUB,IOCUD,IOCUF
 N IOCUON,IOCUOFF,IOCUU,IODCH,IODHLB,IODHLT,IODL,IODWL,IOECH,IOEDALL
 N IOEDBOP,IOEDEOP,IOEFLD,IOELALL,IOELBOL,IOELEOL,IOENTER,IOFIND
 N IOHDWN,IOHOME,IOHTS,IOHUP,IOICH,IOIL,IOIND,IOINHI,IOINLOW,IOINORM
 N IOINSERT,IOKP0,IOKP1,IOKP2,IOKP3,IOKP4,IOKP5,IOKP6,IOKP7,IOKP8,IOKP9
 N IOIRM0,IOIRM1,IOKPAM,IOKPNM,IOMC,IOMINUS,IONEL,IONEXTSC,IOPERIOD
 N IOPF1,IOPF2,IOPF3,IOPF4,IOPREVSC,IOPROB,IOPTCH10,IOPTCH12,IOPTCH16
 N IORC,IOREMOVE,IORESET,IORI,IORVOFF,IORVON,IOSC,IOSGR0,IOSELECT
 N IOSTBM,IOSWL,IOTBC,IOTBCALL,IOUOFF,IOUON,IOIS
 ;
 ;------------------------*******----------------------------------
 D TERM^PXBCC
 D FIX1^PXBCC
 D HDR3^PXBUTL(DFN,1)
 D REQ^PXBDREQ(8)
 D EN0^PXBDVST
 D LOC^PXBCC(15,0)
 D WIN17^PXBCC(PXBCNT)
 D VST^PXBPVST
 D FULL0^PXBCC
 D CLEAR1^PXBCC
 K ^TMP("PXBKY",$J),^TMP("PXBSAM",$J),^TMP("PXBSKY",$J),^TMP("PXBVSTG",$J),^TMP("PXBU",$J),^TMP("PXBDVST",$J)
 ;
 ;
 Q
 ;---END OF PROMPTING