- PXUTLVST ;ISL/DEE,PKR - Looks up the visit to see if there is already one ;04/11/2024
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**238**;Aug 12, 1996;Build 3
- ;
- Q
- ;
- FINDVISIT(DFN,VDT,HLOC,SVC,DSS,INS,TYPE,ENCTYPE,CSVC,VISITLIST) ;Use the "AET" and "AA" indexes
- ;to search for existing visits. Requires Patient (DFN) and Visit Date and Time (VDT). Hospital Location
- ;is required unless SVC="E". Institution (INS), Type, Encounter Type (ENCTYPE), DSS ID (DSS), and
- ;Service Category (SVC) are optional. If they are passed as "", then they are not
- ;included in the visit matching. If DSS and INS are passed as "NULL" then the match will be
- ;if these fields are NULL in the visit file entry.
- ;
- ;Credit Stop visits are not returned as a match because they are created and managed by
- ;Scheduling.
- ;
- ;DATA2PCE can change the input value of Service Category depending on if the patient was an
- ;inpatient or outpatient on the date of the encounter. It can also change the Service Category
- ;to "T" if the name of the Clinic Stop contains "TELE". If there is a possibility the input value of
- ;SVC may not be correct pass CSVC=1 to determine if SVC could have been changed and include
- ;the changed value in the matching.
- ;
- I (+DFN'>0)!('$$VFMDATE^PXDATE(VDT,"ST")) S VISITLIST(0)=-1 Q
- I (SVC'="E"),(+HLOC'>0) S VISITLIST(0)=-1 Q
- I (SVC="E"),(HLOC="") S HLOC=0
- ;
- N APPTVST,DATE,DSST,ENCTYP,INP,INVDT,IPM,NFOUND,SVCMATCH,SVCT,TEMP,TESTSVC,TIME
- N VISITIEN,VISITINDEX,VSIT
- S VSIT("VDT")=VDT
- S VSIT("PAT")=DFN
- S VSIT("LOC")=HLOC
- S VSIT("INS")=$G(INS)
- S VSIT("DSS")=$G(DSS)
- S VSIT("TYPE")=$G(TYPE)
- S VSIT("ENCTYPE")=$G(ENCTYPE)
- S VSIT("SVC")=$G(SVC)
- S NFOUND=0
- S TESTSVC=""
- ;
- I ($G(CSVC)=1),(VSIT("SVC")'=""),(VSIT("SVC")'="E"),(VSIT("SVC")'="H") D
- .;Use this special check for inpatient status.
- . S IPM=$$IP^VSITCK1(VDT,DFN)
- . S INP=$S(IPM>0:1,1:0)
- . I (VSIT("DSS")'="NULL"),(+VSIT("DSS")>0) S DSST=VSIT("DSS")
- . I ((VSIT("DSS")="")!(VSIT("DSS")="NULL")),(+VSIT("LOC")>0) S DSST=+$P(^SC(VSIT("LOC"),0),U,7)
- .;If the Stop Code is not in file #150.1, the Service Category cannot be X or D. It will be changed
- .;when EN^PXKCO is called from the protocol event SDAM APPOINTMENT EVENTS. This event is fired
- .;as part of SDAM PCE EVENT (D EN^SDPCE) which in turn is run directly from EVENT^PXKMASC.
- . I DSST>0 D
- .. S SVCT=$S((VSIT("SVC")="X")!(VSIT("SVC")="D")&('$D(^VSIT(150.1,"B",DSST))):"A",1:VSIT("SVC"))
- .. S TESTSVC=$$SVC^PXKCO(SVCT,DSST,INP,VSIT("LOC"))
- ;
- ;When the Service Category is "E" do not try to match the Hospital Location.
- I VSIT("SVC")="E" S VSIT("LOC")=0
- ;
- ;Get the visit for the appointment if there is one.
- S APPTVST=$$APPT2VST^PXUTL1(DFN,VDT,HLOC)
- I APPTVST>0 D
- . S TEMP=$G(^AUPNVSIT(APPTVST,0))
- . S SVCMATCH=0
- . I (VSIT("SVC")'=""),(VSIT("SVC")=$P(TEMP,U,7)) S SVCMATCH=1
- . I (SVCMATCH=0),(TESTSVC'=""),(TESTSVC=$P(TEMP,U,7)) S SVCMATCH=1
- . I SVCMATCH=0 Q
- .;
- . I (VSIT("TYPE")'=""),(VSIT("TYPE")'=$P(TEMP,U,3)) Q
- . I (VSIT("DSS")="NULL"),($P(TEMP,U,8)'="") Q
- . I (VSIT("DSS")'=""),(VSIT("DSS")'="NULL"),(VSIT("DSS")'=$P(TEMP,U,8)) Q
- .;
- . I (VSIT("INS")="NULL"),($P(TEMP,U,6)'="") Q
- . I (VSIT("INS")'=""),(VSIT("INS")'="NULL"),(VSIT("INS")'=$P(TEMP,U,6)) Q
- . S ENCTYP=($P($G(^AUPNVSIT(APPTVST,150)),U,3))
- .;Ignore Credit Stop encounters.
- . I ENCTYP="C" Q
- . I (VSIT("ENCTYPE")'=""),(VSIT("ENCTYPE")'=(ENCTYP)) Q
- . S NFOUND=NFOUND+1,VISITLIST(NFOUND)=APPTVST,VISITLIST(NFOUND,"A")="",VISITINDEX(APPTVST)=""
- ;
- I VSIT("ENCTYPE")'="" D
- . S ENCTYP=""
- . F S ENCTYP=$O(^AUPNVSIT("AET",DFN,VDT,HLOC,ENCTYP)) Q:ENCTYP="" D
- ..;Ignore Credit Stop encounters.
- .. I ENCTYP="C" Q
- .. I (VSIT("ENCTYPE")'=ENCTYP) Q
- .. S VISITIEN=""
- .. F S VISITIEN=$O(^AUPNVSIT("AET",DFN,VDT,HLOC,ENCTYP,VISITIEN)) Q:VISITIEN="" D
- ... I $D(VISITINDEX(VISITIEN)) Q
- ... S TEMP=$G(^AUPNVSIT(VISITIEN,0))
- ... S SVCMATCH=1
- ... I (VSIT("SVC")'=""),(VSIT("SVC")'=$P(TEMP,U,7)) S SVCMATCH=0
- ... I (SVCMATCH=0),($G(TESTSVC)'=""),(TESTSVC=$P(TEMP,U,7)) S SVCMATCH=1
- ... I SVCMATCH=0 Q
- ...;
- ... I (VSIT("TYPE")'=""),(VSIT("TYPE")'=$P(TEMP,U,3)) Q
- ... I (VSIT("DSS")="NULL"),($P(TEMP,U,8)'="") Q
- ... I (VSIT("DSS")'=""),(VSIT("DSS")'="NULL"),(VSIT("DSS")'=$P(TEMP,U,8)) Q
- ...;
- ... I (VSIT("INS")="NULL"),($P(TEMP,U,6)'="") Q
- ... I (VSIT("INS")'=""),(VSIT("INS")="NULL"),(VSIT("INS")'=$P(TEMP,U,6)) Q
- ... S NFOUND=NFOUND+1,VISITLIST(NFOUND)=VISITIEN,VISITINDEX(VISITIEN)=""
- ;
- S DATE=$P(VDT,".",1),TIME=$P(VDT,".",2)
- S INVDT=(9999999-DATE)
- I TIME'="" S INVDT=INVDT_"."_TIME
- S VISITIEN=0
- F S VISITIEN=+$O(^AUPNVSIT("AA",DFN,INVDT,VISITIEN)) Q:VISITIEN=0 D
- . I $D(VISITINDEX(VISITIEN)) Q
- . S ENCTYP=$P($G(^AUPNVSIT(VISITIEN,150)),U,3)
- . I ENCTYP="C" Q
- . I (VSIT("ENCTYPE")'=""),(VSIT("ENCTYPE")'=(ENCTYP)) Q
- . S TEMP=$G(^AUPNVSIT(VISITIEN,0))
- . I (VSIT("LOC")'=0),(VSIT("LOC")'=$P(TEMP,U,22)) Q
- . S SVCMATCH=0
- . I (VSIT("SVC")'=""),(VSIT("SVC")=$P(TEMP,U,7)) S SVCMATCH=1
- . I (SVCMATCH=0),(TESTSVC'=""),(TESTSVC=$P(TEMP,U,7)) S SVCMATCH=1
- . I SVCMATCH=0 Q
- .;
- . I (VSIT("TYPE")'=""),(VSIT("TYPE")'=$P(TEMP,U,3)) Q
- . I (VSIT("DSS")="NULL"),($P(TEMP,U,8)'="") Q
- . I (VSIT("DSS")'=""),(VSIT("DSS")'="NULL"),(VSIT("DSS")'=$P(TEMP,U,8)) Q
- .;
- . I (VSIT("INS")="NULL"),($P(TEMP,U,6)'="") Q
- . I (VSIT("INS")'=""),(VSIT("INS")'="NULL"),(VSIT("INS")'=$P(TEMP,U,6)) Q
- . S NFOUND=NFOUND+1,VISITLIST(NFOUND)=VISITIEN
- S VISITLIST(0)=NFOUND
- I NFOUND'>1 Q
- ;
- ;Process multiple matches.
- N APPTIND,DECOUNT,KEEPIEN,KEEPIND,NREFS,NREFSD,NVISITS,TEMPLIST
- S APPTIND=""
- F IND=1:1:NFOUND D
- . I $D(VISITLIST(IND,"A")) S APPTIND=IND
- . S VISITIEN=VISITLIST(IND)
- . S DECOUNT=+$P(^AUPNVSIT(VISITIEN,0),U,9)
- . S NREFSD(DECOUNT,IND)=VISITIEN
- ;Order the list based on dependency count; largest dependency count is first. Remove
- ;visits with no references.
- S NREFS="",NVISITS=0
- F S NREFS=+$O(NREFSD(NREFS),-1) Q:NREFS=0 D
- . S IND=""
- . F S IND=$O(NREFSD(NREFS,IND)) Q:IND="" D
- .. S NVISITS=NVISITS+1,TEMPLIST(NVISITS)=VISITLIST(IND)
- .. I $D(VISITLIST(IND,"A")) S TEMPLIST(IND,"A")=""
- ;If no visits have references return the first one.
- I NVISITS=0 D Q
- . S KEEPIND=$O(NREFSD(0,""))
- . S KEEPIEN=VISITLIST(KEEPIND)
- . S APPTIND=$S($D(VISITLIST(KEEPIND,"A")):KEEPIND,1:"")
- . K VISITLIST
- . S VISITLIST(0)=1,VISITLIST(1)=KEEPIEN
- . I APPTIND=KEEPIND S VISITLIST(1,"A")=""
- ;
- K VISITLIST
- S VISITLIST(0)=NVISITS
- F IND=1:1:NVISITS D
- . S VISITLIST(IND)=TEMPLIST(IND)
- . I $D(TEMPLIST(IND,"A")) S VISITLIST(IND,"A")=""
- Q
- ;
- ;=========
- LOOKVSIT(PAT,VDT,LOC,DSS,INS,TYP) ;Calls visit tracking to see if there is
- ;already a visit.
- ;Get the visit for the appointment is there is one
- N APPTVST
- S APPTVST=$$APPT2VST^PXUTL1(PAT,VDT,LOC)
- I APPTVST>0 Q APPTVST
- ;
- N VSIT,VSITPKG
- S VSIT("IEN")=""
- S VSIT("VDT")=VDT
- S VSIT("PAT")=PAT
- S VSIT("LOC")=LOC
- S VSIT("INS")=$G(INS)
- S VSIT("TYP")=$G(TYP)
- S VSIT("DSS")=$G(DSS)
- I VSIT("DSS")="",$P($G(^SC(+VSIT("LOC"),0)),"^",7)>0 S VSIT("DSS")=$P(^SC(+VSIT("LOC"),0),"^",7)
- S VSITPKG="PX"
- S VSIT(0)="D0EM"
- ;
- ;CALL FOR VSIT
- D ^VSIT
- I '$D(VSIT("IEN"))#2 Q -1
- Q $P(VSIT("IEN"),"^",1)
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXUTLVST 7269 printed Jan 18, 2025@03:32:42 Page 2
- PXUTLVST ;ISL/DEE,PKR - Looks up the visit to see if there is already one ;04/11/2024
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**238**;Aug 12, 1996;Build 3
- +2 ;
- +3 QUIT
- +4 ;
- FINDVISIT(DFN,VDT,HLOC,SVC,DSS,INS,TYPE,ENCTYPE,CSVC,VISITLIST) ;Use the "AET" and "AA" indexes
- +1 ;to search for existing visits. Requires Patient (DFN) and Visit Date and Time (VDT). Hospital Location
- +2 ;is required unless SVC="E". Institution (INS), Type, Encounter Type (ENCTYPE), DSS ID (DSS), and
- +3 ;Service Category (SVC) are optional. If they are passed as "", then they are not
- +4 ;included in the visit matching. If DSS and INS are passed as "NULL" then the match will be
- +5 ;if these fields are NULL in the visit file entry.
- +6 ;
- +7 ;Credit Stop visits are not returned as a match because they are created and managed by
- +8 ;Scheduling.
- +9 ;
- +10 ;DATA2PCE can change the input value of Service Category depending on if the patient was an
- +11 ;inpatient or outpatient on the date of the encounter. It can also change the Service Category
- +12 ;to "T" if the name of the Clinic Stop contains "TELE". If there is a possibility the input value of
- +13 ;SVC may not be correct pass CSVC=1 to determine if SVC could have been changed and include
- +14 ;the changed value in the matching.
- +15 ;
- +16 IF (+DFN'>0)!('$$VFMDATE^PXDATE(VDT,"ST"))
- SET VISITLIST(0)=-1
- QUIT
- +17 IF (SVC'="E")
- IF (+HLOC'>0)
- SET VISITLIST(0)=-1
- QUIT
- +18 IF (SVC="E")
- IF (HLOC="")
- SET HLOC=0
- +19 ;
- +20 NEW APPTVST,DATE,DSST,ENCTYP,INP,INVDT,IPM,NFOUND,SVCMATCH,SVCT,TEMP,TESTSVC,TIME
- +21 NEW VISITIEN,VISITINDEX,VSIT
- +22 SET VSIT("VDT")=VDT
- +23 SET VSIT("PAT")=DFN
- +24 SET VSIT("LOC")=HLOC
- +25 SET VSIT("INS")=$GET(INS)
- +26 SET VSIT("DSS")=$GET(DSS)
- +27 SET VSIT("TYPE")=$GET(TYPE)
- +28 SET VSIT("ENCTYPE")=$GET(ENCTYPE)
- +29 SET VSIT("SVC")=$GET(SVC)
- +30 SET NFOUND=0
- +31 SET TESTSVC=""
- +32 ;
- +33 IF ($GET(CSVC)=1)
- IF (VSIT("SVC")'="")
- IF (VSIT("SVC")'="E")
- IF (VSIT("SVC")'="H")
- Begin DoDot:1
- +34 ;Use this special check for inpatient status.
- +35 SET IPM=$$IP^VSITCK1(VDT,DFN)
- +36 SET INP=$SELECT(IPM>0:1,1:0)
- +37 IF (VSIT("DSS")'="NULL")
- IF (+VSIT("DSS")>0)
- SET DSST=VSIT("DSS")
- +38 IF ((VSIT("DSS")="")!(VSIT("DSS")="NULL"))
- IF (+VSIT("LOC")>0)
- SET DSST=+$PIECE(^SC(VSIT("LOC"),0),U,7)
- +39 ;If the Stop Code is not in file #150.1, the Service Category cannot be X or D. It will be changed
- +40 ;when EN^PXKCO is called from the protocol event SDAM APPOINTMENT EVENTS. This event is fired
- +41 ;as part of SDAM PCE EVENT (D EN^SDPCE) which in turn is run directly from EVENT^PXKMASC.
- +42 IF DSST>0
- Begin DoDot:2
- +43 SET SVCT=$SELECT((VSIT("SVC")="X")!(VSIT("SVC")="D")&('$DATA(^VSIT(150.1,"B",DSST))):"A",1:VSIT("SVC"))
- +44 SET TESTSVC=$$SVC^PXKCO(SVCT,DSST,INP,VSIT("LOC"))
- End DoDot:2
- End DoDot:1
- +45 ;
- +46 ;When the Service Category is "E" do not try to match the Hospital Location.
- +47 IF VSIT("SVC")="E"
- SET VSIT("LOC")=0
- +48 ;
- +49 ;Get the visit for the appointment if there is one.
- +50 SET APPTVST=$$APPT2VST^PXUTL1(DFN,VDT,HLOC)
- +51 IF APPTVST>0
- Begin DoDot:1
- +52 SET TEMP=$GET(^AUPNVSIT(APPTVST,0))
- +53 SET SVCMATCH=0
- +54 IF (VSIT("SVC")'="")
- IF (VSIT("SVC")=$PIECE(TEMP,U,7))
- SET SVCMATCH=1
- +55 IF (SVCMATCH=0)
- IF (TESTSVC'="")
- IF (TESTSVC=$PIECE(TEMP,U,7))
- SET SVCMATCH=1
- +56 IF SVCMATCH=0
- QUIT
- +57 ;
- +58 IF (VSIT("TYPE")'="")
- IF (VSIT("TYPE")'=$PIECE(TEMP,U,3))
- QUIT
- +59 IF (VSIT("DSS")="NULL")
- IF ($PIECE(TEMP,U,8)'="")
- QUIT
- +60 IF (VSIT("DSS")'="")
- IF (VSIT("DSS")'="NULL")
- IF (VSIT("DSS")'=$PIECE(TEMP,U,8))
- QUIT
- +61 ;
- +62 IF (VSIT("INS")="NULL")
- IF ($PIECE(TEMP,U,6)'="")
- QUIT
- +63 IF (VSIT("INS")'="")
- IF (VSIT("INS")'="NULL")
- IF (VSIT("INS")'=$PIECE(TEMP,U,6))
- QUIT
- +64 SET ENCTYP=($PIECE($GET(^AUPNVSIT(APPTVST,150)),U,3))
- +65 ;Ignore Credit Stop encounters.
- +66 IF ENCTYP="C"
- QUIT
- +67 IF (VSIT("ENCTYPE")'="")
- IF (VSIT("ENCTYPE")'=(ENCTYP))
- QUIT
- +68 SET NFOUND=NFOUND+1
- SET VISITLIST(NFOUND)=APPTVST
- SET VISITLIST(NFOUND,"A")=""
- SET VISITINDEX(APPTVST)=""
- End DoDot:1
- +69 ;
- +70 IF VSIT("ENCTYPE")'=""
- Begin DoDot:1
- +71 SET ENCTYP=""
- +72 FOR
- SET ENCTYP=$ORDER(^AUPNVSIT("AET",DFN,VDT,HLOC,ENCTYP))
- if ENCTYP=""
- QUIT
- Begin DoDot:2
- +73 ;Ignore Credit Stop encounters.
- +74 IF ENCTYP="C"
- QUIT
- +75 IF (VSIT("ENCTYPE")'=ENCTYP)
- QUIT
- +76 SET VISITIEN=""
- +77 FOR
- SET VISITIEN=$ORDER(^AUPNVSIT("AET",DFN,VDT,HLOC,ENCTYP,VISITIEN))
- if VISITIEN=""
- QUIT
- Begin DoDot:3
- +78 IF $DATA(VISITINDEX(VISITIEN))
- QUIT
- +79 SET TEMP=$GET(^AUPNVSIT(VISITIEN,0))
- +80 SET SVCMATCH=1
- +81 IF (VSIT("SVC")'="")
- IF (VSIT("SVC")'=$PIECE(TEMP,U,7))
- SET SVCMATCH=0
- +82 IF (SVCMATCH=0)
- IF ($GET(TESTSVC)'="")
- IF (TESTSVC=$PIECE(TEMP,U,7))
- SET SVCMATCH=1
- +83 IF SVCMATCH=0
- QUIT
- +84 ;
- +85 IF (VSIT("TYPE")'="")
- IF (VSIT("TYPE")'=$PIECE(TEMP,U,3))
- QUIT
- +86 IF (VSIT("DSS")="NULL")
- IF ($PIECE(TEMP,U,8)'="")
- QUIT
- +87 IF (VSIT("DSS")'="")
- IF (VSIT("DSS")'="NULL")
- IF (VSIT("DSS")'=$PIECE(TEMP,U,8))
- QUIT
- +88 ;
- +89 IF (VSIT("INS")="NULL")
- IF ($PIECE(TEMP,U,6)'="")
- QUIT
- +90 IF (VSIT("INS")'="")
- IF (VSIT("INS")="NULL")
- IF (VSIT("INS")'=$PIECE(TEMP,U,6))
- QUIT
- +91 SET NFOUND=NFOUND+1
- SET VISITLIST(NFOUND)=VISITIEN
- SET VISITINDEX(VISITIEN)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +92 ;
- +93 SET DATE=$PIECE(VDT,".",1)
- SET TIME=$PIECE(VDT,".",2)
- +94 SET INVDT=(9999999-DATE)
- +95 IF TIME'=""
- SET INVDT=INVDT_"."_TIME
- +96 SET VISITIEN=0
- +97 FOR
- SET VISITIEN=+$ORDER(^AUPNVSIT("AA",DFN,INVDT,VISITIEN))
- if VISITIEN=0
- QUIT
- Begin DoDot:1
- +98 IF $DATA(VISITINDEX(VISITIEN))
- QUIT
- +99 SET ENCTYP=$PIECE($GET(^AUPNVSIT(VISITIEN,150)),U,3)
- +100 IF ENCTYP="C"
- QUIT
- +101 IF (VSIT("ENCTYPE")'="")
- IF (VSIT("ENCTYPE")'=(ENCTYP))
- QUIT
- +102 SET TEMP=$GET(^AUPNVSIT(VISITIEN,0))
- +103 IF (VSIT("LOC")'=0)
- IF (VSIT("LOC")'=$PIECE(TEMP,U,22))
- QUIT
- +104 SET SVCMATCH=0
- +105 IF (VSIT("SVC")'="")
- IF (VSIT("SVC")=$PIECE(TEMP,U,7))
- SET SVCMATCH=1
- +106 IF (SVCMATCH=0)
- IF (TESTSVC'="")
- IF (TESTSVC=$PIECE(TEMP,U,7))
- SET SVCMATCH=1
- +107 IF SVCMATCH=0
- QUIT
- +108 ;
- +109 IF (VSIT("TYPE")'="")
- IF (VSIT("TYPE")'=$PIECE(TEMP,U,3))
- QUIT
- +110 IF (VSIT("DSS")="NULL")
- IF ($PIECE(TEMP,U,8)'="")
- QUIT
- +111 IF (VSIT("DSS")'="")
- IF (VSIT("DSS")'="NULL")
- IF (VSIT("DSS")'=$PIECE(TEMP,U,8))
- QUIT
- +112 ;
- +113 IF (VSIT("INS")="NULL")
- IF ($PIECE(TEMP,U,6)'="")
- QUIT
- +114 IF (VSIT("INS")'="")
- IF (VSIT("INS")'="NULL")
- IF (VSIT("INS")'=$PIECE(TEMP,U,6))
- QUIT
- +115 SET NFOUND=NFOUND+1
- SET VISITLIST(NFOUND)=VISITIEN
- End DoDot:1
- +116 SET VISITLIST(0)=NFOUND
- +117 IF NFOUND'>1
- QUIT
- +118 ;
- +119 ;Process multiple matches.
- +120 NEW APPTIND,DECOUNT,KEEPIEN,KEEPIND,NREFS,NREFSD,NVISITS,TEMPLIST
- +121 SET APPTIND=""
- +122 FOR IND=1:1:NFOUND
- Begin DoDot:1
- +123 IF $DATA(VISITLIST(IND,"A"))
- SET APPTIND=IND
- +124 SET VISITIEN=VISITLIST(IND)
- +125 SET DECOUNT=+$PIECE(^AUPNVSIT(VISITIEN,0),U,9)
- +126 SET NREFSD(DECOUNT,IND)=VISITIEN
- End DoDot:1
- +127 ;Order the list based on dependency count; largest dependency count is first. Remove
- +128 ;visits with no references.
- +129 SET NREFS=""
- SET NVISITS=0
- +130 FOR
- SET NREFS=+$ORDER(NREFSD(NREFS),-1)
- if NREFS=0
- QUIT
- Begin DoDot:1
- +131 SET IND=""
- +132 FOR
- SET IND=$ORDER(NREFSD(NREFS,IND))
- if IND=""
- QUIT
- Begin DoDot:2
- +133 SET NVISITS=NVISITS+1
- SET TEMPLIST(NVISITS)=VISITLIST(IND)
- +134 IF $DATA(VISITLIST(IND,"A"))
- SET TEMPLIST(IND,"A")=""
- End DoDot:2
- End DoDot:1
- +135 ;If no visits have references return the first one.
- +136 IF NVISITS=0
- Begin DoDot:1
- +137 SET KEEPIND=$ORDER(NREFSD(0,""))
- +138 SET KEEPIEN=VISITLIST(KEEPIND)
- +139 SET APPTIND=$SELECT($DATA(VISITLIST(KEEPIND,"A")):KEEPIND,1:"")
- +140 KILL VISITLIST
- +141 SET VISITLIST(0)=1
- SET VISITLIST(1)=KEEPIEN
- +142 IF APPTIND=KEEPIND
- SET VISITLIST(1,"A")=""
- End DoDot:1
- QUIT
- +143 ;
- +144 KILL VISITLIST
- +145 SET VISITLIST(0)=NVISITS
- +146 FOR IND=1:1:NVISITS
- Begin DoDot:1
- +147 SET VISITLIST(IND)=TEMPLIST(IND)
- +148 IF $DATA(TEMPLIST(IND,"A"))
- SET VISITLIST(IND,"A")=""
- End DoDot:1
- +149 QUIT
- +150 ;
- +151 ;=========
- LOOKVSIT(PAT,VDT,LOC,DSS,INS,TYP) ;Calls visit tracking to see if there is
- +1 ;already a visit.
- +2 ;Get the visit for the appointment is there is one
- +3 NEW APPTVST
- +4 SET APPTVST=$$APPT2VST^PXUTL1(PAT,VDT,LOC)
- +5 IF APPTVST>0
- QUIT APPTVST
- +6 ;
- +7 NEW VSIT,VSITPKG
- +8 SET VSIT("IEN")=""
- +9 SET VSIT("VDT")=VDT
- +10 SET VSIT("PAT")=PAT
- +11 SET VSIT("LOC")=LOC
- +12 SET VSIT("INS")=$GET(INS)
- +13 SET VSIT("TYP")=$GET(TYP)
- +14 SET VSIT("DSS")=$GET(DSS)
- +15 IF VSIT("DSS")=""
- IF $PIECE($GET(^SC(+VSIT("LOC"),0)),"^",7)>0
- SET VSIT("DSS")=$PIECE(^SC(+VSIT("LOC"),0),"^",7)
- +16 SET VSITPKG="PX"
- +17 SET VSIT(0)="D0EM"
- +18 ;
- +19 ;CALL FOR VSIT
- +20 DO ^VSIT
- +21 IF '$DATA(VSIT("IEN"))#2
- QUIT -1
- +22 QUIT $PIECE(VSIT("IEN"),"^",1)
- +23 ;