PXQGVST ;ISL/JVS - GATHER ENCOUNTERS ;8/29/96 10:32
;;1.0;PCE PATIENT CARE ENCOUNTER;**4**;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 (required)
;
; ..'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"
;
;
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,GROUP2
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 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
END ...;---END OF SCREENS-----
...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,CATE,CATI,GROUP1
N APP,DISP,HIST
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;.07;.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 CATE=$G(^UTILITY("DIQ1",$J,9000010,DA,.07,"E"))
..S CATI=$G(^UTILITY("DIQ1",$J,9000010,DA,.07,"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"))
..I $$VSTAPPT^PXUTL1(DFN,$P(^AUPNVSIT(IEN,0),"^",1),$P(^AUPNVSIT(IEN,0),"^",22),IEN) S APP="APP"
..I $$DISPOSIT^PXUTL1(DFN,$P(^AUPNVSIT(IEN,0),"^",1),IEN) S DISP="DIS"
..I $P(^AUPNVSIT(IEN,0),"^",7)="E" S HIST="HIS"
..S STATUS=$P($$STATUS^SDPCE(IEN),"^",2)
..S GROUP=VSTDTE_"^"_VSTDTI_"^"_HLOCE_"^"_HLOCI_"^"_PRIME_"^"_PRIMI_"^"_UID_"^"_STATUS
..S GROUP1=IEN_"^"_VSTDTI_"^"_HLOCI_"^"_CATI_"^"_PRIMI_"^"_$G(APP)_"^"_$G(DISP)_"^"_$G(HIST)
..S GROUP2=IEN_"^"_VSTDTI_"^"_HLOCI_"^"_$P($G(^AUPNVSIT(IEN,0)),"^",23)_"^"_$P($G(^AUPNVSIT(IEN,0)),"^",24)_"^"_$P($G(^AUPNVSIT(IEN,812)),"^",2)_"^"_$P($G(^AUPNVSIT(IEN,812)),"^",3)
..K APP,DISP,HIST
..S ^TMP("PXBVSTG",$J,VSTDTI,IEN)=$S($G(PXQINT):GROUP1,$G(PXQSOR):GROUP2,1: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^PXQGVST1
Q VAL
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXQGVST 4996 printed Nov 22, 2024@17:40:05 Page 2
PXQGVST ;ISL/JVS - GATHER ENCOUNTERS ;8/29/96 10:32
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**4**;Aug 12, 1996
+2 ;
+3 ;
+4 ;
VISITLST(DFN,BEGINDT,ENDDT,HLOC,SCREEN,APPOINT,PROMPT,COSTATUS) ;--GATHER VISITS
+1 ;
+2 ; DFN = Patient Identification entry number (required)
+3 ; BEGINDT = Begining date of date range-INTERNAL FORMAT (optional)
+4 ; ENDDT = Ending date of date range-INTERNAL FORMAT (optional)
+5 ; HLOC = Hospital Location (pointer to file#44) (optional)
+6 ; SCREEN = Code as related to field 15003 (required)
+7 ;
+8 ; ..'A'=ANCILLARY
+9 ; ..'P'=PRIMARY
+10 ; ..'O'=OCCASION OF SERIVCE
+11 ; ..'S'=STOP CODES
+12 ; ..'X'=All three above plus the 'NULL' Encounters (DEFAULT)
+13 ;
+14 ; ..'E'=Historical Encounters ('XE' for all historical visits)
+15 ;
+16 ; APPOINT
+17 ; ..-1
+18 ; ..0
+19 ; ..1
+20 ; OUTPUT:
+21 ; >0 = VISIT IEN
+22 ; =0 = User selected to add a visit
+23 ; -1 = No visit selected
+24 ; -2^"TEXT" = error of some kind^mesage about error
+25 ;
+26 ;
+27 ;--Validate A PATIENT visit is sent in
+28 IF $GET(DFN)<1
QUIT -2_"^"_"NO PATIENT"
+29 IF '$DATA(^AUPNPAT(DFN))
QUIT -2_"^"_"NO SUCH PATIENT"
+30 ;
+31 ;
+32 NEW STOP
+33 IF $GET(HLOC)
Begin DoDot:1
+34 IF '$DATA(^SC(HLOC))
SET STOP=1
End DoDot:1
if $GET(STOP)
QUIT -2_"^"_"NO SUCH HOSPITAL LOCATION"
+35 ;
+36 ;--NEW variables
+37 NEW IEN,INDATEI,INDATEE,PXBC,PXBCC,VST,PXBI,SCRN,SCRN1,ENDDTT,BEGINDTT
+38 NEW PXBHIGH,PXBCNT,PXBWIN,PXBSAVE,PXBDT,DEL,NOD0,NOD150,UID,STATUS
+39 NEW HLOCE,HLOCI,VAL,VAR,GROUP2
+40 SET (PXBC,PXBCC)=0
+41 ;--KILL variables
+42 KILL ^TMP("PXBU",$JOB),^UTILITY("DIQ1",$JOB),^TMP("PXBKY",$JOB),^TMP("PXBSAM",$JOB),^TMP("PXBSKY",$JOB),GROUP
+43 ;--CREATE tmp global
+44 ;-SET UP SCREEN
+45 IF $DATA(SCREEN)
Begin DoDot:1
+46 SET PXBI=""
FOR PXBI=1:1:$LENGTH(SCREEN)
SET SCRN($EXTRACT(SCREEN,PXBI))=""
+47 IF '$DATA(SCRN)
SET SCRN("X")=""
End DoDot:1
+48 IF $DATA(^AUPNVSIT("AA",DFN))
Begin DoDot:1
+49 IF $GET(ENDDT)
SET ENDDTT=9999999-$PIECE(ENDDT,".",1)
if ENDDT["."
SET ENDDTT=ENDDTT_((ENDDT#1)-(.0001))
if ENDDT'["."
SET ENDDTT=(ENDDTT)-(.0001)
SET ENDDT=ENDDTT
+50 IF $GET(BEGINDT)
SET BEGINDTT=9999999-$PIECE(BEGINDT,".",1)
if BEGINDT["."
SET BEGINDTT=BEGINDTT_(BEGINDT#1)
if BEGINDT'["."
SET BEGINDTT=BEGINDTT_".999999"
SET BEGINDT=BEGINDTT
+51 IF '$GET(BEGINDT)
SET BEGINDT=999999999
+52 SET PXBDT=$SELECT($GET(ENDDT):ENDDT,1:"")
+53 FOR
SET PXBDT=$ORDER(^AUPNVSIT("AA",DFN,PXBDT))
if PXBDT>BEGINDT
QUIT
if PXBDT'>0
QUIT
Begin DoDot:2
+54 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVSIT("AA",DFN,PXBDT,IEN))
if IEN=""
QUIT
Begin DoDot:3
+55 ;
+56 ;-----SCREEN-------
+57 ;----BRING IN ALL NODES
+58 SET NOD0=$GET(^AUPNVSIT(IEN,0))
SET NOD150=$GET(^AUPNVSIT(IEN,150))
+59 ;--SCREEN BASED ON PARAMETER
+60 SET SCRN1=$PIECE(NOD150,"^",3)
+61 IF SCRN1=""
IF '$DATA(SCRN("X"))
QUIT
+62 IF $DATA(SCRN("X"))
GOTO CON
+63 IF SCRN1="A"
IF '$DATA(SCRN("A"))
QUIT
+64 IF SCRN1="O"
IF '$DATA(SCRN("O"))
QUIT
+65 IF SCRN1="P"
IF '$DATA(SCRN("P"))
QUIT
+66 IF SCRN1="S"
IF '$DATA(SCRN("S"))
QUIT
+67 IF SCRN1="C"
IF '$DATA(SCRN("C"))
QUIT
CON ;--CONTINUE
END ;---END OF SCREENS-----
+1 SET PXBC=PXBC+1
+2 SET ^TMP("PXBU",$JOB,"VST",IEN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+3 KILL SCRN,SCRN1
+4 ;
+5 ;
A ;--Set array with the VISITS from the visits
+1 NEW DIQ,PRIME,PRIMI,PXBDT,VSTDTE,VSTDTI,GROUP,CATE,CATI,GROUP1
+2 NEW APP,DISP,HIST
+3 IF $DATA(^TMP("PXBU",$JOB,"VST"))
Begin DoDot:1
+4 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("PXBU",$JOB,"VST",IEN))
if IEN'>0
QUIT
Begin DoDot:2
+5 SET DIC=9000010
SET DR=".01;.07;.22;15003;15001"
SET DA=IEN
SET DIQ(0)="EI"
DO EN^DIQ1
+6 SET VSTDTE=$GET(^UTILITY("DIQ1",$JOB,9000010,DA,.01,"E"))
+7 SET VSTDTE=$PIECE(VSTDTE,"@",1)_" "_$PIECE($PIECE(VSTDTE,"@",2),":",1,2)
+8 SET VSTDTI=$GET(^UTILITY("DIQ1",$JOB,9000010,DA,.01,"I"))
+9 SET CATE=$GET(^UTILITY("DIQ1",$JOB,9000010,DA,.07,"E"))
+10 SET CATI=$GET(^UTILITY("DIQ1",$JOB,9000010,DA,.07,"I"))
+11 SET HLOCE=$GET(^UTILITY("DIQ1",$JOB,9000010,DA,.22,"E"))
+12 SET HLOCI=$GET(^UTILITY("DIQ1",$JOB,9000010,DA,.22,"I"))
+13 SET PRIME=$GET(^UTILITY("DIQ1",$JOB,9000010,DA,15003,"E"))
+14 SET PRIMI=$GET(^UTILITY("DIQ1",$JOB,9000010,DA,15003,"I"))
+15 SET UID=$GET(^UTILITY("DIQ1",$JOB,9000010,DA,15001,"E"))
+16 IF $$VSTAPPT^PXUTL1(DFN,$PIECE(^AUPNVSIT(IEN,0),"^",1),$PIECE(^AUPNVSIT(IEN,0),"^",22),IEN)
SET APP="APP"
+17 IF $$DISPOSIT^PXUTL1(DFN,$PIECE(^AUPNVSIT(IEN,0),"^",1),IEN)
SET DISP="DIS"
+18 IF $PIECE(^AUPNVSIT(IEN,0),"^",7)="E"
SET HIST="HIS"
+19 SET STATUS=$PIECE($$STATUS^SDPCE(IEN),"^",2)
+20 SET GROUP=VSTDTE_"^"_VSTDTI_"^"_HLOCE_"^"_HLOCI_"^"_PRIME_"^"_PRIMI_"^"_UID_"^"_STATUS
+21 SET GROUP1=IEN_"^"_VSTDTI_"^"_HLOCI_"^"_CATI_"^"_PRIMI_"^"_$GET(APP)_"^"_$GET(DISP)_"^"_$GET(HIST)
+22 SET GROUP2=IEN_"^"_VSTDTI_"^"_HLOCI_"^"_$PIECE($GET(^AUPNVSIT(IEN,0)),"^",23)_"^"_$PIECE($GET(^AUPNVSIT(IEN,0)),"^",24)_"^"_$PIECE($GET(^AUPNVSIT(IEN,812)),"^",2)_"^"_$PIECE($GET(^AUPNVSIT(IEN,812)),"^",3)
+23 KILL APP,DISP,HIST
+24 SET ^TMP("PXBVSTG",$JOB,VSTDTI,IEN)=$SELECT($GET(PXQINT):GROUP1,$GET(PXQSOR):GROUP2,1:GROUP)
End DoDot:2
End DoDot:1
+25 KILL DIC,DR,DA
+26 ;
+27 ;
B ;--ADD Line Numbers
+1 IF $DATA(^TMP("PXBVSTG",$JOB))
Begin DoDot:1
+2 SET PXBCC=PXBC+1
SET VST=""
FOR
SET VST=$ORDER(^TMP("PXBVSTG",$JOB,VST))
if VST=""
QUIT
Begin DoDot:2
+3 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("PXBVSTG",$JOB,VST,IEN))
if IEN=""
QUIT
SET PXBCC=PXBCC-1
Begin DoDot:3
+4 SET ^TMP("PXBKY",$JOB,VST,PXBCC)=$GET(^TMP("PXBVSTG",$JOB,VST,IEN))
+5 SET ^TMP("PXBSAM",$JOB,PXBCC)=$GET(^TMP("PXBVSTG",$JOB,VST,IEN))
+6 SET ^TMP("PXBSKY",$JOB,PXBCC,IEN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+7 ;
F ;--FINISH UP THE VARIABLES
+1 KILL ^TMP("PXBU",$JOB),^UTILITY("DIQ1",$JOB)
+2 SET PXBCNT=+$GET(PXBC)
+3 DO DISP^PXQGVST1
+4 QUIT VAL
+5 ;
