- 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 Apr 23, 2025@18:44:23 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 ;
