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

VSITDEF.m

Go to the documentation of this file. 
  1. VSITDEF ;ISL/dee - Defaulting Logic for the Visit ;4/17/97
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**76,111,130,164,168**;Aug 12, 1996;Build 14
  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,2**;Aug 12, 1996
  1.  ;
  1.  Q  ; - not an entry point
  1.  ;
  1. REQUIRED() ;Check the required variables
  1.  ;and Default all fields that are need for lookup matching
  1.  ; Returns: 0 if no errors and 
  1.  ;          1 if there are errors that prevent processing
  1.  ;          (stored in QUIT)
  1.  N QUIT,SITE
  1.  S QUIT=0
  1.  S SITE=+$$SITE^VASITE($P($G(VSIT("VDT")),"^"))
  1.  ; - VDT
  1.  S VSIT("VDT")=$$ERRCHK^VSITCK("VDT",VSIT("VDT"),$S(VSIT("SVC")="E":"TS",1:""))
  1.  I $L(VSIT("VDT"),"^")>1 D ERR^VSITPUT($P(VSIT("VDT"),"^",2,99)) S QUIT=1
  1.  ; - PAT
  1.  S VSIT("PAT")=$$ERRCHK^VSITCK("PAT",VSIT("PAT"))
  1.  I $L(VSIT("PAT"),"^")>1 D ERR^VSITPUT($P(VSIT("PAT"),"^",2,99)) S QUIT=1
  1.  I VSIT("INS")="",VSIT("OUT")="",VSIT("SVC")'="E" D
  1.  . S VSIT("INS")=$$INS4LOC^VSITCK1(+VSIT("LOC"))
  1.  . I VSIT("INS")']"",SITE>0 S VSIT("INS")=SITE
  1.  . S VSIT("INS")=$$ERRCHK^VSITCK("INS",VSIT("INS"))
  1.  I $L(VSIT("INS"),"^")>1 D ERR^VSITPUT($P(VSIT("INS"),"^",2,99)) S QUIT=1
  1.  ; - LOC
  1.  I (VSIT("INS")=SITE&(VSIT("SVC")'="E"))!(VSIT("LOC")]"") D
  1.  . S VSIT("LOC")=$$ERRCHK^VSITCK("LOC",VSIT("LOC"))
  1.  I $L(VSIT("LOC"),"^")>1 D ERR^VSITPUT($P(VSIT("LOC"),"^",2,99)) S QUIT=1
  1.  ; - TYP
  1.  I VSIT("TYP")']"",VSIT("INS")]"" S VSIT("TYP")="V"
  1.  I VSIT("TYP")']"",VSIT("SVC")="E" S VSIT("TYP")="O"
  1.  S:VSIT("TYP")']"" VSIT("TYP")=$G(DUZ("AG"))
  1.  S:VSIT("TYP")']"" VSIT("TYP")=$P($G(^DIC(150.9,1,0)),"^",3)
  1.  S VSIT("TYP")=$$ERRCHK^VSITCK("TYP",VSIT("TYP"))
  1.  I $L(VSIT("TYP"),"^")>1 D ERR^VSITPUT($P(VSIT("TYP"),"^",2,99)) S QUIT=1
  1.  ; - DSS
  1.  I VSIT("DSS")="",VSIT("LOC")]"" D
  1.  . S VSIT("DSS")=$$DSS4LOC^VSITCK1(+VSIT("LOC"))
  1.  I VSIT("DSS")]"" D
  1.  . S VSIT("DSS")=$$ERRCHK^VSITCK("DSS",VSIT("DSS"))
  1.  I $L(VSIT("DSS"),"^")>1 D ERR^VSITPUT($P(VSIT("DSS"),"^",2,99)) S QUIT=1
  1.  ; - IO
  1.  S VSIT("IO")=$S(VSITIPM>0:1,1:0)
  1.  ; - SVC
  1.  I VSIT("SVC")'="E" D
  1.  . I +VSIT("DSS") D
  1.  .. ;Default svc based on the dss id
  1.  .. I $P(^DIC(40.7,+VSIT("DSS"),0),"^",1)["TELE" S VSIT("SVC")="T" ;any TELEphone
  1.  .. E  I $O(^VSIT(150.1,"B",+$P(^DIC(40.7,+VSIT("DSS"),0),"^",2),0)) S VSIT("SVC")="X"
  1.  .. E  I VSIT("SVC")="",VSIT("DSS")=$P($G(^SC(+VSIT("LOC"),0)),"^",7) S VSIT("SVC")="A"
  1.  . I VSIT("SVC")="" S VSIT("SVC")="X"
  1.  I VSIT("IO") D
  1.  . I VSIT("SVC")="A" S VSIT("SVC")="I"
  1.  . E  I VSIT("SVC")="X" S VSIT("SVC")="D"
  1.  E  D
  1.  . I VSIT("SVC")="I" S VSIT("SVC")="A"
  1.  . E  I VSIT("SVC")="D" S VSIT("SVC")="X"
  1.  S VSIT("SVC")=$$ERRCHK^VSITCK("SVC",VSIT("SVC"))
  1.  I $L(VSIT("SVC"),"^")>1 D ERR^VSITPUT($P(VSIT("SVC"),"^",2,99)) S QUIT=1
  1.  ;
  1.  Q QUIT
  1.  ;
  1. DEFAULTS ;Default all of the rest of the fields that are NOT need for lookup matching
  1.  ; - CDT & MDT
  1.  D
  1.  . N %,%H,%I,X
  1.  . D NOW^%DTC
  1.  . S (VSIT("CDT"),VSIT("MDT"))=%
  1.  ; - LNK
  1.  ;   check if good
  1.  D:VSIT("LNK")]""
  1.  . S VSIT("LNK")=$$GET^VSITVAR("LNK",VSIT("LNK"))
  1.  . I +VSIT("LNK"),+VSIT("PAT") D
  1.  . . S NOD=$G(^AUPNVSIT(+VSIT("LNK"),0))
  1.  . . S:+$P(NOD,"^",11) VSIT("LNK")="" ; delete flag
  1.  . . S:+VSIT("PAT")'=$P(NOD,"^",5) VSIT("LNK")="" ; different patients
  1.  S VSIT("LNK")=$$ERRCHK^VSITCK("LNK",VSIT("LNK"))
  1.  D:$L(VSIT("LNK"),"^")>1 WRN^VSITPUT($P(VSIT("LNK"),"^",2,99))
  1.  ; - COD
  1.  S VSIT("COD")=$$ERRCHK^VSITCK("COD",VSIT("COD"))
  1.  D:$L(VSIT("COD"),"^")>1 WRN^VSITPUT($P(VSIT("COD"),"^",2,99))
  1.  ; - ELG
  1.  I +VSIT("PAT"),$F(VSIT(0),"I")!($F(VSIT(0),"E")) D
  1.  . S:VSIT(0)["I" VSIT("ELG")=$$ELG^VSITASK(VSIT("PAT"))
  1.  . D:VSIT("ELG")=""
  1.  . . S:VSIT("LNK")>0 VSIT("ELG")=$P($G(^AUPNVSIT(VSIT("LNK"),0)),"^",21) ;Eligibility Code form Parent Visit
  1.  . . S:VSIT("ELG")="" VSIT("ELG")=$P($G(^DPT(+VSIT("PAT"),.36)),"^") ;Primary Eligibility Code
  1.  . . D:VSIT("ELG")=""
  1.  . . . N VSITI,VSITE
  1.  . . . S (VSITI,VSITE)=0
  1.  . . . ;See if any eligibilities it the Patient Eigibilities sub-file
  1.  . . . F  S VSITE=$O(^DPT(+VSIT("PAT"),"E",VSITE)) Q:VSITE'>0  S VSITI=VSITI+1
  1.  . . . I VSITI=1 S VSIT("ELG")=$O(^DPT(+VSIT("PAT"),"E",0)) ;If only one use it
  1.  S VSIT("ELG")=$$ERRCHK^VSITCK("ELG",VSIT("ELG"))
  1.  D:$L(VSIT("ELG"),"^")>1 WRN^VSITPUT($P(VSIT("ELG"),"^",2,99))
  1.  ; - USR
  1.  I VSIT("USR")="",+$G(DUZ) S VSIT("USR")=+DUZ
  1.  S VSIT("USR")=$$ERRCHK^VSITCK("USR",VSIT("USR"))
  1.  D:$L(VSIT("USR"),"^")>1 WRN^VSITPUT($P(VSIT("USR"),"^",2,99))
  1.  ; - OPT
  1.  S:VSIT("OPT")="" VSIT("OPT")=$P($G(XQY),"^")
  1.  S VSIT("OPT")=$$ERRCHK^VSITCK("OPT",VSIT("OPT"))
  1.  D:$L(VSIT("OPT"),"^")>1 WRN^VSITPUT($P(VSIT("OPT"),"^",2,99))
  1.  ; - PRO
  1.  I VSIT("PRO")="",$P($G(XQORNOD),";",2)="ORD(101," S VSIT("PRO")=$P($G(XQORNOD),";")
  1.  S VSIT("PRO")=$$ERRCHK^VSITCK("PRO",VSIT("PRO"))
  1.  D:$L(VSIT("PRO"),"^")>1 WRN^VSITPUT($P(VSIT("PRO"),"^",2,99))
  1.  ; - OUT
  1.  S VSIT("OUT")=$$ERRCHK^VSITCK("OUT",VSIT("OUT"))
  1.  D:$L(VSIT("OUT"),"^")>1 WRN^VSITPUT($P(VSIT("OUT"),"^",2,99))
  1.  ; - VID
  1.  S VSIT("VID")=$$GETVID^VSITVID
  1.  ; - PRI
  1.  I VSIT("PRI")="P",$O(^VSIT(150.1,"B",+$P($G(^DIC(40.7,+VSIT("DSS"),0)),"^",2),0)) S VSIT("PRI")="O"
  1.  S VSIT("PRI")=$$ERRCHK^VSITCK("PRI",VSIT("PRI"))
  1.  D:$L(VSIT("PRI"),"^")>1 WRN^VSITPUT($P(VSIT("PRI"),"^",2,99))
  1.  ; - SC
  1.  S VSIT("SC")=$$ERRCHK^VSITCK("SC",VSIT("SC"))
  1.  D:$L(VSIT("SC"),"^")>1 WRN^VSITPUT($P(VSIT("SC"),"^",2,99))
  1.  ; - AO
  1.  S VSIT("AO")=$$ERRCHK^VSITCK("AO",VSIT("AO"))
  1.  D:$L(VSIT("AO"),"^")>1 WRN^VSITPUT($P(VSIT("AO"),"^",2,99))
  1.  ; - IR
  1.  S VSIT("IR")=$$ERRCHK^VSITCK("IR",VSIT("IR"))
  1.  D:$L(VSIT("IR"),"^")>1 WRN^VSITPUT($P(VSIT("IR"),"^",2,99))
  1.  ; - EC
  1.  S VSIT("EC")=$$ERRCHK^VSITCK("EC",VSIT("EC"))
  1.  D:$L(VSIT("EC"),"^")>1 WRN^VSITPUT($P(VSIT("EC"),"^",2,99))
  1.  ; - HNC - PX*1*111 - Head & Neck
  1.  S VSIT("HNC")=$$ERRCHK^VSITCK("HNC",VSIT("HNC"))
  1.  D:$L(VSIT("HNC"),"^")>1 WRN^VSITPUT($P(VSIT("HNC"),"^",2,99))
  1.  ; - CV - PX*1*130 - Combat Vet
  1.  S VSIT("CV")=$$ERRCHK^VSITCK("CV",VSIT("CV"))
  1.  D:$L(VSIT("CV"),"^")>1 WRN^VSITPUT($P(VSIT("CV"),"^",2,99))
  1.  ; - SHAD - PX*1*168 - Project 112/SHAD
  1.  S VSIT("SHAD")=$$ERRCHK^VSITCK("SHAD",VSIT("SHAD"))
  1.  D:$L(VSIT("SHAD"),"^")>1 WRN^VSITPUT($P(VSIT("SHAD"),"^",2,99))
  1.  ; - COM
  1.  S VSIT("COM")=$$ERRCHK^VSITCK("COM",VSIT("COM"))
  1.  D:$L(VSIT("COM"),"^")>1 WRN^VSITPUT($P(VSIT("COM"),"^",2,99))
  1.  ; - VER
  1.  S VSIT("VER")=$$ERRCHK^VSITCK("VER",VSIT("VER"))
  1.  D:$L(VSIT("VER"),"^")>1 WRN^VSITPUT($P(VSIT("VER"),"^",2,99))
  1.  ; - PKG
  1.  S VSIT("PKG")=$$PKG2IEN^VSIT(VSIT("PKG"))
  1.  S VSIT("PKG")=$$ERRCHK^VSITCK("PKG",VSIT("PKG"))
  1.  D:$L(VSIT("PKG"),"^")>1 WRN^VSITPUT($P(VSIT("PKG"),"^",2,99))
  1.  ; - SOR
  1.  ;Lookup source in PCE DATA SOURCE file (#839.7) with LAYGO
  1.  I VSIT("SOR")'=+VSIT("SOR") D
  1.  . I $T(SOURCE^PXAPI)="" D
  1.  .. S VSIT("SOR")=$$SOURCE^PXAPI(VSIT("SOR"))
  1.  . E  S VSIT("SOR")=""
  1.  S VSIT("SOR")=$$ERRCHK^VSITCK("SOR",VSIT("SOR"))
  1.  D:$L(VSIT("SOR"),"^")>1 WRN^VSITPUT($P(VSIT("SOR"),"^",2,99))
  1.  ;
  1.  ;PFSS Patient Reference
  1.  S VSIT("ACT")=$$ERRCHK^VSITCK("ACT",VSIT("ACT"))
  1.  I $$SWSTAT^IBBAPI() D:$L(VSIT("ACT"),"^")>1 WRN^VSITPUT($P(VSIT("ACT"),"^",2,99))
  1.  Q
  1.  ;