- 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 Jan 18, 2025@03:33:31 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