VSITGET ;ISD/RJP - Visit Return Search and Match Logic of a Visit ;6/20/96
;;1.0;PCE PATIENT CARE ENCOUNTER;**76**;Aug 12, 1996
; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect
; the incorporation of the module into PCE. For historical reference,
; the old (VISIT TRACKING) 2nd line is included below to reference VSIT
; patches.
;
;;2.0;VISIT TRACKING;;Aug 12, 1996;
;
Q ; - not an entry point
;
LST(VDT,DFN,PRAM,VSIT,VSITGET) ; - search for matches
; - called by ^VSIT and Supported Direct Call
;
; - VSIT & VSITGET are passed by reference
; - pass {VDT/VSIT("VDT")} = <FM date [and time]>
; {DFN/VSIT("PAT")} = <patient pointer>
; [PRAM/VSIT(0)] = <param string>
; [VSIT("xxx")] = <used in matching logic if VSIT(0)["M">
; [<fld-value>[^...]] for multiple values
; .VSITGET = <array passed by reference>
; - rtns .VSITGET = <number of matches>
; .VSITGET(<ien>) = <sorted by visit date>
; (array of selected visits)
K VSITGET
S VSITGET=0
;
S:$G(VDT)]"" VSIT("VDT")=VDT
S:$G(DFN) VSIT("PAT")=+DFN
S:$G(PRAM)]"" VSIT(0)=PRAM
I '+$G(VSIT("VDT"))!('+$G(VSIT("PAT"))) G QUIT
;
I '($D(^TMP("VSITDD",$J))\10) D FLD^VSITFLD
N NOD,IEN,VSITDAT,VSITBEG,VSITEND,VSITSORT,VSITIPV
;
D:$G(VSIT("SVC"))="" CKIP(VSIT("VDT"),VSIT("PAT"))
;
D RANGE
S VSITDAT=VSITBEG
F S VSITDAT=$O(^AUPNVSIT("AA",+VSIT("PAT"),VSITDAT)) Q:VSITDAT'>0!(VSITDAT>VSITEND) D
. D:$G(VSIT("SVC"))="" CKIP(9999999-$P(VSITDAT,"."),VSIT("PAT"))
. S IEN=0
. F S IEN=$O(^AUPNVSIT("AA",+VSIT("PAT"),VSITDAT,IEN)) Q:IEN'>0 D
.. S NOD=$$MATCH(IEN)
.. S:NOD]"" VSITSORT($P(NOD,"^"),$P(NOD,"^",2),IEN)=IEN_"|"_NOD
.. K:$D(VSITIPV(IEN)) VSITIPV(IEN)
;
S VSITIPV=0 F S VSITIPV=$O(VSITIPV(VSITIPV)) Q:VSITIPV="" D
. S IEN=VSITIPV
. S NOD=$$MATCH(IEN)
. S:NOD]"" VSITSORT($P(NOD,"^"),$P(NOD,"^",2),IEN)=IEN_"|"_NOD
;
;Put into VSITGET in sorted order
S VSITGET=0
S NOD=$Q(VSITSORT(0,0,0))
G:NOD="" QUIT ;no visit found
;Set first one
S VSITGET=VSITGET+1
S VSITGET(VSITGET)=@NOD
;Set rest
I NOD]"" F S NOD=$Q(@NOD) Q:NOD="" S VSITGET=VSITGET+1,VSITGET(VSITGET)=@NOD
;
QUIT ; - exit
;
Q
;
CKIP(DATE,PAT) ; - check to see if inpatient over date range but admitted earlier
;
N IPM,IPV
S IPM=$$IP^VSITCK1(DATE,PAT)
I +IPM,'$P($G(^DIC(150.9,1,0)),"^",5) D
. S IPV=+$P($G(^DGPM(IPM,0)),"^",27)
. S:'$D(VSITIPV(IPV)) VSITIPV(IPV)=""
Q
;
MATCH(IEN) ; - screen matches using visit array
;
; - pass IEN = <internal entry number of visit node>
; - rtns NOD = <zero node of ien record or null>
;
Q:'IEN ""
S NOD=$G(^AUPNVSIT(IEN,0))
Q:+$P(NOD,"^",11) ""
I $G(VSIT(0))["M" D
. N X,VSITI,VSITM
. F X="DSS","LOC","INS","TYP" D:$G(VSIT(X))]"" Q:NOD=""
.. S VSITM=0
.. F VSITI=1:1:$L(VSIT(X),"^") S:$P(VSIT(X),"^",VSITI)=$P(NOD,"^",$P(^TMP("VSITDD",$J,X),";",4)) VSITM=1
.. S:'VSITM NOD=""
Q NOD
;
RANGE ; - date range
;
; - pass VSIT("VDT") = <FM date [and time]>
; VSIT(0) = <param string> ; will assume D1 if not specified
; - rtns VSITBEG = 9's complement of FM search start date
; VSITEND = 9's complement of FM search end date
;
N X,X1,X2
S X1=+VSIT("VDT")
S X2=$F($G(VSIT(0)),"D")
I X2>1 S X2=$E($G(VSIT(0)),$F($G(VSIT(0)),"D"),99),X2=$S(X2>0:-(X2-1),1:0)
E S X2=0
D C^%DTC
S VSITBEG=9999999-$P(+VSIT("VDT"),".")+$S(+$F($G(VSIT(0)),"D0"):"."_$P(+VSIT("VDT"),".",2)-.0000001,1:"-.0000001")
S VSITEND=9999999-$P(+X,".")_$S(+$F($G(VSIT(0)),"D0"):"."_$P(+VSIT("VDT"),".",2)+.0000001,1:".999999")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVSITGET 3720 printed Apr 09, 2024@21:28:28 Page 2
VSITGET ;ISD/RJP - Visit Return Search and Match Logic of a Visit ;6/20/96
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**76**;Aug 12, 1996
+2 ; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect
+3 ; the incorporation of the module into PCE. For historical reference,
+4 ; the old (VISIT TRACKING) 2nd line is included below to reference VSIT
+5 ; patches.
+6 ;
+7 ;;2.0;VISIT TRACKING;;Aug 12, 1996;
+8 ;
+9 ; - not an entry point
QUIT
+10 ;
LST(VDT,DFN,PRAM,VSIT,VSITGET) ; - search for matches
+1 ; - called by ^VSIT and Supported Direct Call
+2 ;
+3 ; - VSIT & VSITGET are passed by reference
+4 ; - pass {VDT/VSIT("VDT")} = <FM date [and time]>
+5 ; {DFN/VSIT("PAT")} = <patient pointer>
+6 ; [PRAM/VSIT(0)] = <param string>
+7 ; [VSIT("xxx")] = <used in matching logic if VSIT(0)["M">
+8 ; [<fld-value>[^...]] for multiple values
+9 ; .VSITGET = <array passed by reference>
+10 ; - rtns .VSITGET = <number of matches>
+11 ; .VSITGET(<ien>) = <sorted by visit date>
+12 ; (array of selected visits)
+13 KILL VSITGET
+14 SET VSITGET=0
+15 ;
+16 if $GET(VDT)]""
SET VSIT("VDT")=VDT
+17 if $GET(DFN)
SET VSIT("PAT")=+DFN
+18 if $GET(PRAM)]""
SET VSIT(0)=PRAM
+19 IF '+$GET(VSIT("VDT"))!('+$GET(VSIT("PAT")))
GOTO QUIT
+20 ;
+21 IF '($DATA(^TMP("VSITDD",$JOB))\10)
DO FLD^VSITFLD
+22 NEW NOD,IEN,VSITDAT,VSITBEG,VSITEND,VSITSORT,VSITIPV
+23 ;
+24 if $GET(VSIT("SVC"))=""
DO CKIP(VSIT("VDT"),VSIT("PAT"))
+25 ;
+26 DO RANGE
+27 SET VSITDAT=VSITBEG
+28 FOR
SET VSITDAT=$ORDER(^AUPNVSIT("AA",+VSIT("PAT"),VSITDAT))
if VSITDAT'>0!(VSITDAT>VSITEND)
QUIT
Begin DoDot:1
+29 if $GET(VSIT("SVC"))=""
DO CKIP(9999999-$PIECE(VSITDAT,"."),VSIT("PAT"))
+30 SET IEN=0
+31 FOR
SET IEN=$ORDER(^AUPNVSIT("AA",+VSIT("PAT"),VSITDAT,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+32 SET NOD=$$MATCH(IEN)
+33 if NOD]""
SET VSITSORT($PIECE(NOD,"^"),$PIECE(NOD,"^",2),IEN)=IEN_"|"_NOD
+34 if $DATA(VSITIPV(IEN))
KILL VSITIPV(IEN)
End DoDot:2
End DoDot:1
+35 ;
+36 SET VSITIPV=0
FOR
SET VSITIPV=$ORDER(VSITIPV(VSITIPV))
if VSITIPV=""
QUIT
Begin DoDot:1
+37 SET IEN=VSITIPV
+38 SET NOD=$$MATCH(IEN)
+39 if NOD]""
SET VSITSORT($PIECE(NOD,"^"),$PIECE(NOD,"^",2),IEN)=IEN_"|"_NOD
End DoDot:1
+40 ;
+41 ;Put into VSITGET in sorted order
+42 SET VSITGET=0
+43 SET NOD=$QUERY(VSITSORT(0,0,0))
+44 ;no visit found
if NOD=""
GOTO QUIT
+45 ;Set first one
+46 SET VSITGET=VSITGET+1
+47 SET VSITGET(VSITGET)=@NOD
+48 ;Set rest
+49 IF NOD]""
FOR
SET NOD=$QUERY(@NOD)
if NOD=""
QUIT
SET VSITGET=VSITGET+1
SET VSITGET(VSITGET)=@NOD
+50 ;
QUIT ; - exit
+1 ;
+2 QUIT
+3 ;
CKIP(DATE,PAT) ; - check to see if inpatient over date range but admitted earlier
+1 ;
+2 NEW IPM,IPV
+3 SET IPM=$$IP^VSITCK1(DATE,PAT)
+4 IF +IPM
IF '$PIECE($GET(^DIC(150.9,1,0)),"^",5)
Begin DoDot:1
+5 SET IPV=+$PIECE($GET(^DGPM(IPM,0)),"^",27)
+6 if '$DATA(VSITIPV(IPV))
SET VSITIPV(IPV)=""
End DoDot:1
+7 QUIT
+8 ;
MATCH(IEN) ; - screen matches using visit array
+1 ;
+2 ; - pass IEN = <internal entry number of visit node>
+3 ; - rtns NOD = <zero node of ien record or null>
+4 ;
+5 if 'IEN
QUIT ""
+6 SET NOD=$GET(^AUPNVSIT(IEN,0))
+7 if +$PIECE(NOD,"^",11)
QUIT ""
+8 IF $GET(VSIT(0))["M"
Begin DoDot:1
+9 NEW X,VSITI,VSITM
+10 FOR X="DSS","LOC","INS","TYP"
if $GET(VSIT(X))]""
Begin DoDot:2
+11 SET VSITM=0
+12 FOR VSITI=1:1:$LENGTH(VSIT(X),"^")
if $PIECE(VSIT(X),"^",VSITI)=$PIECE(NOD,"^",$PIECE(^TMP("VSITDD",$JOB,X),";",4))
SET VSITM=1
+13 if 'VSITM
SET NOD=""
End DoDot:2
if NOD=""
QUIT
End DoDot:1
+14 QUIT NOD
+15 ;
RANGE ; - date range
+1 ;
+2 ; - pass VSIT("VDT") = <FM date [and time]>
+3 ; VSIT(0) = <param string> ; will assume D1 if not specified
+4 ; - rtns VSITBEG = 9's complement of FM search start date
+5 ; VSITEND = 9's complement of FM search end date
+6 ;
+7 NEW X,X1,X2
+8 SET X1=+VSIT("VDT")
+9 SET X2=$FIND($GET(VSIT(0)),"D")
+10 IF X2>1
SET X2=$EXTRACT($GET(VSIT(0)),$FIND($GET(VSIT(0)),"D"),99)
SET X2=$SELECT(X2>0:-(X2-1),1:0)
+11 IF '$TEST
SET X2=0
+12 DO C^%DTC
+13 SET VSITBEG=9999999-$PIECE(+VSIT("VDT"),".")+$SELECT(+$FIND($GET(VSIT(0)),"D0"):"."_$PIECE(+VSIT("VDT"),".",2)-.0000001,1:"-.0000001")
+14 SET VSITEND=9999999-$PIECE(+X,".")_$SELECT(+$FIND($GET(VSIT(0)),"D0"):"."_$PIECE(+VSIT("VDT"),".",2)+.0000001,1:".999999")
+15 QUIT
