Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VSIT

VSIT.m

Go to the documentation of this file.
  1. VSIT ;ISD/MRL,RJP,PKR - Visit Tracking ;03/29/2018
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**76,111,118,164,211**;Aug 12, 1996;Build 454
  1. ; Patch PX*1*76 changes the 2nd line of all VSIT* routines to reflect
  1. ; the incorporation of the module into PCE. For historical reference,
  1. ; the old (VISIT TRACKING) 2nd line is included below to reference VSIT
  1. ; patches.
  1. ;
  1. ;;2.0;VISIT TRACKING;**1**;Aug 12, 1996
  1. ;
  1. ; - pass VSIT = <visit date [and time] in FM format>
  1. ; DFN = <patient file pointer>
  1. ; [VSIT(0)] = <functional parameters>
  1. ; [VSIT("xxx")] = <used in match logic if VSIT(0)["M">
  1. ; - rtns VSIT("IEN") = <visit record # in format as Y w/ ^DIC>
  1. ; VSIT(##,"XXX") = visit values passed by mnemonics
  1. ; If VSIT("IEN") = -1 Error in creation/lookup.
  1. ; If Vsit("IEN") = -2 Package is turned off or not defined in the
  1. ; Visit Tracking Parameters file.
  1. S VSIT("IEN")=$$GET($G(VSIT),$G(DFN),$G(VSIT(0)),.VSIT)
  1. EXIT ;
  1. Q
  1. ;
  1. GET(VDT,DFN,PRAM,VSIT) ; find or create a visit
  1. ;
  1. ; - pass {VDT/VSIT("VDT")} = <visit date [and time] in FM format>
  1. ; {DFN/VSIT("PAT")} = <patient file pointer>
  1. ; [PRAM/VSIT(0)] = <functional parameters>
  1. ; [VSIT("xxx")] = <array w/ mnemonic subscript>
  1. ; <used in match logic if VISIT(O)["M">
  1. ; <for SVC, TYP, INS, DSS, ELG , LOC>
  1. ; - rtns = <visit record # in format as Y w/ ^DIC>
  1. I $G(VSITPKG)]"" S VSIT("PKG")=VSITPKG
  1. E S (VSITPKG,VSIT("PKG"))=$G(VSIT("PKG"))
  1. N PKGP
  1. S PKGP=$$PKG2IEN^VSIT0($G(VSITPKG))
  1. I PKGP=-1 S VSIT("IEN")=-2 G DONE
  1. ;Get the site part of the VISIT ID
  1. I $P($G(^DIC(150.9,1,4)),"^",2)<1 S VSIT("IEN")=-1 G DONE
  1. ;
  1. K VSIT("IEN"),^TMP("VSITDD",$J),^TMP($J,"VSIT-ERROR")
  1. S:$G(VDT)]"" VSIT("VDT")=VDT
  1. S:$G(DFN) VSIT("PAT")=+DFN
  1. S:$G(PRAM)]"" VSIT(0)=PRAM
  1. ;See if the old CLN nodes needs moved into the DSS node.
  1. I '($D(VSIT("DSS"))#2),$D(VSIT("CLN"))#2 S VSIT("DSS")=VSIT("CLN")
  1. ;
  1. D FLD^VSITFLD
  1. ;Set all of the VSIT nodes with $GET
  1. D SETALL^VSITCK
  1. ;
  1. ;Inpatient movement
  1. N VSITIPM S VSITIPM=+$$IP^VSITCK1(+VSIT("VDT"),+VSIT("PAT"))
  1. ;Do the defaulting of the fields that need to be defaulted for lookup
  1. I $$REQUIRED^VSITDEF S VSIT("IEN")=-1 G DONE
  1. ;
  1. D:'$D(DT) DT^DICRW
  1. ;
  1. ;If Force new visit, make the visit and exit
  1. I VSIT(0)["F" D G QUIT
  1. . D DEFAULTS^VSITDEF
  1. . D ^VSITPUT
  1. ;
  1. ;If not forcing new visit try to look up the visit
  1. D LST^VSITGET("","","",.VSIT,.VSITGET)
  1. I $$SWSTAT^IBBAPI(),+$G(VSITGET)=1 D ;PX*1.0*164
  1. . N ACT
  1. . I $G(VSIT("ACT"))']0 S VSIT("ACT")=$P($G(^AUPNVSIT(+VSITGET(1),0)),"^",26) Q
  1. . I $G(VSIT("ACT"))]0 S ACT=VSIT("ACT") K VSIT S VSIT("IEN")=+$P(VSITGET(1),"^"),VSIT("ACT")=ACT D UPD^VSIT ;PX*1.0*164
  1. ;
  1. I +$G(VSITGET)=0,VSIT(0)["N" D G QUIT
  1. . D DEFAULTS^VSITDEF
  1. . D ^VSITPUT
  1. I +$G(VSITGET)=1 S VSIT("IEN")=$P(VSITGET(1),"|")_"^"_$P($P(VSITGET(1),"^"),"|",2) G QUIT
  1. I +$G(VSITGET)>1,VSIT(0)["I" S Y=$$VSIT^VSITASK(VSIT("PAT"),.VSITGET) S:'+Y Y=1 S VSIT("IEN")=$P(VSITGET(+Y),"|")_"^"_$P($P(VSITGET(+Y),"^"),"|",2) G QUIT
  1. I +$G(VSITGET)>1,VSIT(0)'["I" S VSIT("IEN")=$P(VSITGET(1),"|")_"^"_$P($P(VSITGET(1),"^"),"|",2) G QUIT
  1. S VSIT("IEN")=-1
  1. ;
  1. QUIT ; - end of job
  1. ; set vsit api
  1. I +$G(VSIT("IEN"))=0 S VSIT("IEN")=-1
  1. D:VSIT("IEN")>0 ALL^VSITVAR(+VSIT("IEN"),"B",1)
  1. ;
  1. DONE I $D(^TMP($J,"VSIT-ERROR")),$G(VSIT("IEN"))'>0,VSIT(0)["N"!(VSIT(0)["F") D SND^VSITBUL
  1. K VSITGET
  1. K ^TMP("VSITDD",$J)
  1. Q VSIT("IEN")
  1. ;
  1. ADD ; - add to dependency count
  1. ; called via cross references on pointer files
  1. D ADD^AUPNVSIT
  1. Q
  1. ;
  1. SUB ; - subtract from dependency count
  1. ; called via cross references on pointer files
  1. D SUB^AUPNVSIT
  1. Q
  1. ;
  1. UPD ;Update Visit File
  1. Q:$G(VSIT("IEN"))<1
  1. Q:'$D(^AUPNVSIT(VSIT("IEN"),0))
  1. N FDA,HNC,IENS,MSG,VSITDR,VSITFLD
  1. S IENS=VSIT("IEN")_","
  1. S VSIT("MDT")=$$NOW^XLFDT
  1. D FLD^VSITFLD
  1. S VSITDR=""
  1. F S VSITDR=$O(VSIT(VSITDR)) Q:VSITDR="" D
  1. . I $G(^TMP("VSITDD",$J,VSITDR))="" Q
  1. . S VSITFLD=$P(^TMP("VSITDD",$J,VSITDR),";",2) ;Field
  1. . S FDA(9000010,IENS,VSITFLD)=VSIT(VSITDR)
  1. L +^AUPNVSIT(+VSIT("IEN")):DILOCKTM
  1. D FILE^DIE("","FDA","MSG")
  1. L -^AUPNVSIT(+VSIT("IEN"))
  1. I $D(MSG) D Q
  1. . N SUBJECT
  1. . S SUBJECT="UPD^VSIT failed for Visit IEN="_VSIT("IEN")
  1. . D SENDEMSG^PXMCLINK(SUBJECT,.MSG)
  1. K ^TMP("VSITDD",$J)
  1. ;
  1. ;PX*1*111 - Update NTR file for Head & Neck
  1. S HNC=$P($G(^AUPNVSIT(VSIT("IEN"),800)),U,6)
  1. I HNC'=1 Q
  1. N DGARR,PXDFN,SDRES
  1. S PXDFN=$P(^AUPNVSIT(VSIT("IEN"),0),U,5)
  1. I PXDFN="" Q
  1. S SDRES=$$GETCUR^DGNTAPI(PXDFN,"DGARR")
  1. I +$G(DGARR("STAT"))'=3 Q ;NTR File does not require editing
  1. S SDRES=$$FILEHNC^DGNTAPI1(PXDFN)
  1. Q
  1. ;
  1. PKG2IEN(PKG) ;Pass in package name space and
  1. ; returns pointer to the package in the Package file #9.4
  1. Q $$PKG2IEN^VSIT0($G(PKG))
  1. ;
  1. PKG(PKG,VALUE) ;-Entry point to add package to multiple in tracking parameters
  1. ;-PKG=Package Name Space
  1. ;-VALUE=Value on the ON/OFF flag under package multiple
  1. ;--1=ON 0=OFF
  1. Q $$PKG^VSIT0($G(PKG),$G(VALUE))
  1. ;
  1. PKGON(PKG) ; -- Returns the active flag for the package
  1. ; 1 the package can create visits
  1. ; 0 the package cannot create visits
  1. ; -1 called wrong or could not find package in VT parameters file
  1. Q $$PKGON^VSIT0($G(PKG))
  1. ;
  1. IEN2VID(IEN) ; -- Call with Visit IEN and returns the Visit ID
  1. Q:'($D(^AUPNVSIT(+IEN,150))#2) -1
  1. Q $P(^AUPNVSIT(IEN,150),"^",1)
  1. ;
  1. VID2IEN(VID) ; -- Call with Visit's ID and returns the Visit IEN
  1. N IEN
  1. S IEN=$O(^AUPNVSIT("VID",VID,0))
  1. Q $S(IEN]"":IEN,1:-1)
  1. ;
  1. LOOKUP(IEN,FMT,WITHIEN) ; -- Lookup a visit and return all of its information
  1. ;DBIA #: 1906
  1. ;Parameters:
  1. ; IEN is the IEN for the Visit OR the Visit's ID
  1. ; FMT is the format that you want the output where
  1. ; I ::= internal format
  1. ; E ::= external format
  1. ; B ::= both internal and external format
  1. ; B is the default if FMT is anything other than "I" or "E"
  1. ; WITHIEN is 0 if you do not want the IEN of the VSIT( as the first
  1. ; subscript and 1 if you do. "1" is the default.
  1. ;
  1. ;Return: -1 if IEN was not a valid IEN or Visit ID
  1. ; otherwise returns IEN
  1. ; VSIT( an array VSIT(Visit IEN,field) or VSIT(field) depending
  1. ; on the value of WITHIEN. The array is all of the fields
  1. ; in the visit file. If B(oth) internal and external format
  1. ; are returned the format is: internal^external.
  1. ; If I(nternal) format is requested only the internal part
  1. ; is returned.
  1. ; If E(xternal) format is requested the format is: ^external
  1. ; External values, if requested, are always returned in the
  1. ; second pieces of the array elements.
  1. ;
  1. Q:$G(IEN)']"" -1
  1. S:+IEN'=IEN IEN=$$VID2IEN(IEN) ;PX*1.0*118
  1. Q:'($D(^AUPNVSIT(+IEN,0))#2) -1
  1. S FMT=$G(FMT)
  1. S FMT=$S(FMT["B":"B",FMT["I":"I",FMT["E":"E",1:"B")
  1. S WITHIEN=$S($G(WITHIEN)=0:0,1:1)
  1. D ALL^VSITVAR(IEN,FMT,WITHIEN)
  1. Q IEN
  1. ;
  1. SELECTED(DFN,SDT,EDT,HOSLOC,ENCTYPE,NENCTYPE,SERVCAT,NSERVCAT,LASTN) ;
  1. ; -- Returns selected visits depending on screens passed in.
  1. D VSITAPI^VSITOE($G(DFN),$G(SDT),$G(EDT),$G(HOSLOC),$G(ENCTYPE),$G(NENCTYPE),$G(SERVCAT),$G(NSERVCAT),$G(LASTN))
  1. Q
  1. ;
  1. HISTORIC(IEN) ; -- Returns 1 if it is an Historical visit ("E" in #.07)
  1. ; 0 if it is not an Historical visit.
  1. ; -1 if the IEN is bad
  1. Q $S('($D(^AUPNVSIT(IEN,0))#2):-1,1:$P($G(^AUPNVSIT(IEN,0)),"^",7)="E")
  1. ;
  1. MODIFIED(IEN) ;Sets the Date Last Modified (.13) field to NOW
  1. ;
  1. N VSIT
  1. S VSIT("IEN")=IEN
  1. D UPD
  1. Q
  1. ;