VSITDEF ;ISL/dee - Defaulting Logic for the Visit ;4/17/97
;;1.0;PCE PATIENT CARE ENCOUNTER;**76,111,130,164,168**;Aug 12, 1996;Build 14
; 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;**1,2**;Aug 12, 1996
;
Q ; - not an entry point
;
REQUIRED() ;Check the required variables
;and Default all fields that are need for lookup matching
; Returns: 0 if no errors and
; 1 if there are errors that prevent processing
; (stored in QUIT)
N QUIT,SITE
S QUIT=0
S SITE=+$$SITE^VASITE($P($G(VSIT("VDT")),"^"))
; - VDT
S VSIT("VDT")=$$ERRCHK^VSITCK("VDT",VSIT("VDT"),$S(VSIT("SVC")="E":"TS",1:""))
I $L(VSIT("VDT"),"^")>1 D ERR^VSITPUT($P(VSIT("VDT"),"^",2,99)) S QUIT=1
; - PAT
S VSIT("PAT")=$$ERRCHK^VSITCK("PAT",VSIT("PAT"))
I $L(VSIT("PAT"),"^")>1 D ERR^VSITPUT($P(VSIT("PAT"),"^",2,99)) S QUIT=1
I VSIT("INS")="",VSIT("OUT")="",VSIT("SVC")'="E" D
. S VSIT("INS")=$$INS4LOC^VSITCK1(+VSIT("LOC"))
. I VSIT("INS")']"",SITE>0 S VSIT("INS")=SITE
. S VSIT("INS")=$$ERRCHK^VSITCK("INS",VSIT("INS"))
I $L(VSIT("INS"),"^")>1 D ERR^VSITPUT($P(VSIT("INS"),"^",2,99)) S QUIT=1
; - LOC
I (VSIT("INS")=SITE&(VSIT("SVC")'="E"))!(VSIT("LOC")]"") D
. S VSIT("LOC")=$$ERRCHK^VSITCK("LOC",VSIT("LOC"))
I $L(VSIT("LOC"),"^")>1 D ERR^VSITPUT($P(VSIT("LOC"),"^",2,99)) S QUIT=1
; - TYP
I VSIT("TYP")']"",VSIT("INS")]"" S VSIT("TYP")="V"
I VSIT("TYP")']"",VSIT("SVC")="E" S VSIT("TYP")="O"
S:VSIT("TYP")']"" VSIT("TYP")=$G(DUZ("AG"))
S:VSIT("TYP")']"" VSIT("TYP")=$P($G(^DIC(150.9,1,0)),"^",3)
S VSIT("TYP")=$$ERRCHK^VSITCK("TYP",VSIT("TYP"))
I $L(VSIT("TYP"),"^")>1 D ERR^VSITPUT($P(VSIT("TYP"),"^",2,99)) S QUIT=1
; - DSS
I VSIT("DSS")="",VSIT("LOC")]"" D
. S VSIT("DSS")=$$DSS4LOC^VSITCK1(+VSIT("LOC"))
I VSIT("DSS")]"" D
. S VSIT("DSS")=$$ERRCHK^VSITCK("DSS",VSIT("DSS"))
I $L(VSIT("DSS"),"^")>1 D ERR^VSITPUT($P(VSIT("DSS"),"^",2,99)) S QUIT=1
; - IO
S VSIT("IO")=$S(VSITIPM>0:1,1:0)
; - SVC
I VSIT("SVC")'="E" D
. I +VSIT("DSS") D
.. ;Default svc based on the dss id
.. I $P(^DIC(40.7,+VSIT("DSS"),0),"^",1)["TELE" S VSIT("SVC")="T" ;any TELEphone
.. E I $O(^VSIT(150.1,"B",+$P(^DIC(40.7,+VSIT("DSS"),0),"^",2),0)) S VSIT("SVC")="X"
.. E I VSIT("SVC")="",VSIT("DSS")=$P($G(^SC(+VSIT("LOC"),0)),"^",7) S VSIT("SVC")="A"
. I VSIT("SVC")="" S VSIT("SVC")="X"
I VSIT("IO") D
. I VSIT("SVC")="A" S VSIT("SVC")="I"
. E I VSIT("SVC")="X" S VSIT("SVC")="D"
E D
. I VSIT("SVC")="I" S VSIT("SVC")="A"
. E I VSIT("SVC")="D" S VSIT("SVC")="X"
S VSIT("SVC")=$$ERRCHK^VSITCK("SVC",VSIT("SVC"))
I $L(VSIT("SVC"),"^")>1 D ERR^VSITPUT($P(VSIT("SVC"),"^",2,99)) S QUIT=1
;
Q QUIT
;
DEFAULTS ;Default all of the rest of the fields that are NOT need for lookup matching
; - CDT & MDT
D
. N %,%H,%I,X
. D NOW^%DTC
. S (VSIT("CDT"),VSIT("MDT"))=%
; - LNK
; check if good
D:VSIT("LNK")]""
. S VSIT("LNK")=$$GET^VSITVAR("LNK",VSIT("LNK"))
. I +VSIT("LNK"),+VSIT("PAT") D
. . S NOD=$G(^AUPNVSIT(+VSIT("LNK"),0))
. . S:+$P(NOD,"^",11) VSIT("LNK")="" ; delete flag
. . S:+VSIT("PAT")'=$P(NOD,"^",5) VSIT("LNK")="" ; different patients
S VSIT("LNK")=$$ERRCHK^VSITCK("LNK",VSIT("LNK"))
D:$L(VSIT("LNK"),"^")>1 WRN^VSITPUT($P(VSIT("LNK"),"^",2,99))
; - COD
S VSIT("COD")=$$ERRCHK^VSITCK("COD",VSIT("COD"))
D:$L(VSIT("COD"),"^")>1 WRN^VSITPUT($P(VSIT("COD"),"^",2,99))
; - ELG
I +VSIT("PAT"),$F(VSIT(0),"I")!($F(VSIT(0),"E")) D
. S:VSIT(0)["I" VSIT("ELG")=$$ELG^VSITASK(VSIT("PAT"))
. D:VSIT("ELG")=""
. . S:VSIT("LNK")>0 VSIT("ELG")=$P($G(^AUPNVSIT(VSIT("LNK"),0)),"^",21) ;Eligibility Code form Parent Visit
. . S:VSIT("ELG")="" VSIT("ELG")=$P($G(^DPT(+VSIT("PAT"),.36)),"^") ;Primary Eligibility Code
. . D:VSIT("ELG")=""
. . . N VSITI,VSITE
. . . S (VSITI,VSITE)=0
. . . ;See if any eligibilities it the Patient Eigibilities sub-file
. . . F S VSITE=$O(^DPT(+VSIT("PAT"),"E",VSITE)) Q:VSITE'>0 S VSITI=VSITI+1
. . . I VSITI=1 S VSIT("ELG")=$O(^DPT(+VSIT("PAT"),"E",0)) ;If only one use it
S VSIT("ELG")=$$ERRCHK^VSITCK("ELG",VSIT("ELG"))
D:$L(VSIT("ELG"),"^")>1 WRN^VSITPUT($P(VSIT("ELG"),"^",2,99))
; - USR
I VSIT("USR")="",+$G(DUZ) S VSIT("USR")=+DUZ
S VSIT("USR")=$$ERRCHK^VSITCK("USR",VSIT("USR"))
D:$L(VSIT("USR"),"^")>1 WRN^VSITPUT($P(VSIT("USR"),"^",2,99))
; - OPT
S:VSIT("OPT")="" VSIT("OPT")=$P($G(XQY),"^")
S VSIT("OPT")=$$ERRCHK^VSITCK("OPT",VSIT("OPT"))
D:$L(VSIT("OPT"),"^")>1 WRN^VSITPUT($P(VSIT("OPT"),"^",2,99))
; - PRO
I VSIT("PRO")="",$P($G(XQORNOD),";",2)="ORD(101," S VSIT("PRO")=$P($G(XQORNOD),";")
S VSIT("PRO")=$$ERRCHK^VSITCK("PRO",VSIT("PRO"))
D:$L(VSIT("PRO"),"^")>1 WRN^VSITPUT($P(VSIT("PRO"),"^",2,99))
; - OUT
S VSIT("OUT")=$$ERRCHK^VSITCK("OUT",VSIT("OUT"))
D:$L(VSIT("OUT"),"^")>1 WRN^VSITPUT($P(VSIT("OUT"),"^",2,99))
; - VID
S VSIT("VID")=$$GETVID^VSITVID
; - PRI
I VSIT("PRI")="P",$O(^VSIT(150.1,"B",+$P($G(^DIC(40.7,+VSIT("DSS"),0)),"^",2),0)) S VSIT("PRI")="O"
S VSIT("PRI")=$$ERRCHK^VSITCK("PRI",VSIT("PRI"))
D:$L(VSIT("PRI"),"^")>1 WRN^VSITPUT($P(VSIT("PRI"),"^",2,99))
; - SC
S VSIT("SC")=$$ERRCHK^VSITCK("SC",VSIT("SC"))
D:$L(VSIT("SC"),"^")>1 WRN^VSITPUT($P(VSIT("SC"),"^",2,99))
; - AO
S VSIT("AO")=$$ERRCHK^VSITCK("AO",VSIT("AO"))
D:$L(VSIT("AO"),"^")>1 WRN^VSITPUT($P(VSIT("AO"),"^",2,99))
; - IR
S VSIT("IR")=$$ERRCHK^VSITCK("IR",VSIT("IR"))
D:$L(VSIT("IR"),"^")>1 WRN^VSITPUT($P(VSIT("IR"),"^",2,99))
; - EC
S VSIT("EC")=$$ERRCHK^VSITCK("EC",VSIT("EC"))
D:$L(VSIT("EC"),"^")>1 WRN^VSITPUT($P(VSIT("EC"),"^",2,99))
; - HNC - PX*1*111 - Head & Neck
S VSIT("HNC")=$$ERRCHK^VSITCK("HNC",VSIT("HNC"))
D:$L(VSIT("HNC"),"^")>1 WRN^VSITPUT($P(VSIT("HNC"),"^",2,99))
; - CV - PX*1*130 - Combat Vet
S VSIT("CV")=$$ERRCHK^VSITCK("CV",VSIT("CV"))
D:$L(VSIT("CV"),"^")>1 WRN^VSITPUT($P(VSIT("CV"),"^",2,99))
; - SHAD - PX*1*168 - Project 112/SHAD
S VSIT("SHAD")=$$ERRCHK^VSITCK("SHAD",VSIT("SHAD"))
D:$L(VSIT("SHAD"),"^")>1 WRN^VSITPUT($P(VSIT("SHAD"),"^",2,99))
; - COM
S VSIT("COM")=$$ERRCHK^VSITCK("COM",VSIT("COM"))
D:$L(VSIT("COM"),"^")>1 WRN^VSITPUT($P(VSIT("COM"),"^",2,99))
; - VER
S VSIT("VER")=$$ERRCHK^VSITCK("VER",VSIT("VER"))
D:$L(VSIT("VER"),"^")>1 WRN^VSITPUT($P(VSIT("VER"),"^",2,99))
; - PKG
S VSIT("PKG")=$$PKG2IEN^VSIT(VSIT("PKG"))
S VSIT("PKG")=$$ERRCHK^VSITCK("PKG",VSIT("PKG"))
D:$L(VSIT("PKG"),"^")>1 WRN^VSITPUT($P(VSIT("PKG"),"^",2,99))
; - SOR
;Lookup source in PCE DATA SOURCE file (#839.7) with LAYGO
I VSIT("SOR")'=+VSIT("SOR") D
. I $T(SOURCE^PXAPI)="" D
.. S VSIT("SOR")=$$SOURCE^PXAPI(VSIT("SOR"))
. E S VSIT("SOR")=""
S VSIT("SOR")=$$ERRCHK^VSITCK("SOR",VSIT("SOR"))
D:$L(VSIT("SOR"),"^")>1 WRN^VSITPUT($P(VSIT("SOR"),"^",2,99))
;
;PFSS Patient Reference
S VSIT("ACT")=$$ERRCHK^VSITCK("ACT",VSIT("ACT"))
I $$SWSTAT^IBBAPI() D:$L(VSIT("ACT"),"^")>1 WRN^VSITPUT($P(VSIT("ACT"),"^",2,99))
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVSITDEF 7165 printed Oct 16, 2024@18:33:06 Page 2
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
+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;**1,2**;Aug 12, 1996
+8 ;
+9 ; - not an entry point
QUIT
+10 ;
REQUIRED() ;Check the required variables
+1 ;and Default all fields that are need for lookup matching
+2 ; Returns: 0 if no errors and
+3 ; 1 if there are errors that prevent processing
+4 ; (stored in QUIT)
+5 NEW QUIT,SITE
+6 SET QUIT=0
+7 SET SITE=+$$SITE^VASITE($PIECE($GET(VSIT("VDT")),"^"))
+8 ; - VDT
+9 SET VSIT("VDT")=$$ERRCHK^VSITCK("VDT",VSIT("VDT"),$SELECT(VSIT("SVC")="E":"TS",1:""))
+10 IF $LENGTH(VSIT("VDT"),"^")>1
DO ERR^VSITPUT($PIECE(VSIT("VDT"),"^",2,99))
SET QUIT=1
+11 ; - PAT
+12 SET VSIT("PAT")=$$ERRCHK^VSITCK("PAT",VSIT("PAT"))
+13 IF $LENGTH(VSIT("PAT"),"^")>1
DO ERR^VSITPUT($PIECE(VSIT("PAT"),"^",2,99))
SET QUIT=1
+14 IF VSIT("INS")=""
IF VSIT("OUT")=""
IF VSIT("SVC")'="E"
Begin DoDot:1
+15 SET VSIT("INS")=$$INS4LOC^VSITCK1(+VSIT("LOC"))
+16 IF VSIT("INS")']""
IF SITE>0
SET VSIT("INS")=SITE
+17 SET VSIT("INS")=$$ERRCHK^VSITCK("INS",VSIT("INS"))
End DoDot:1
+18 IF $LENGTH(VSIT("INS"),"^")>1
DO ERR^VSITPUT($PIECE(VSIT("INS"),"^",2,99))
SET QUIT=1
+19 ; - LOC
+20 IF (VSIT("INS")=SITE&(VSIT("SVC")'="E"))!(VSIT("LOC")]"")
Begin DoDot:1
+21 SET VSIT("LOC")=$$ERRCHK^VSITCK("LOC",VSIT("LOC"))
End DoDot:1
+22 IF $LENGTH(VSIT("LOC"),"^")>1
DO ERR^VSITPUT($PIECE(VSIT("LOC"),"^",2,99))
SET QUIT=1
+23 ; - TYP
+24 IF VSIT("TYP")']""
IF VSIT("INS")]""
SET VSIT("TYP")="V"
+25 IF VSIT("TYP")']""
IF VSIT("SVC")="E"
SET VSIT("TYP")="O"
+26 if VSIT("TYP")']""
SET VSIT("TYP")=$GET(DUZ("AG"))
+27 if VSIT("TYP")']""
SET VSIT("TYP")=$PIECE($GET(^DIC(150.9,1,0)),"^",3)
+28 SET VSIT("TYP")=$$ERRCHK^VSITCK("TYP",VSIT("TYP"))
+29 IF $LENGTH(VSIT("TYP"),"^")>1
DO ERR^VSITPUT($PIECE(VSIT("TYP"),"^",2,99))
SET QUIT=1
+30 ; - DSS
+31 IF VSIT("DSS")=""
IF VSIT("LOC")]""
Begin DoDot:1
+32 SET VSIT("DSS")=$$DSS4LOC^VSITCK1(+VSIT("LOC"))
End DoDot:1
+33 IF VSIT("DSS")]""
Begin DoDot:1
+34 SET VSIT("DSS")=$$ERRCHK^VSITCK("DSS",VSIT("DSS"))
End DoDot:1
+35 IF $LENGTH(VSIT("DSS"),"^")>1
DO ERR^VSITPUT($PIECE(VSIT("DSS"),"^",2,99))
SET QUIT=1
+36 ; - IO
+37 SET VSIT("IO")=$SELECT(VSITIPM>0:1,1:0)
+38 ; - SVC
+39 IF VSIT("SVC")'="E"
Begin DoDot:1
+40 IF +VSIT("DSS")
Begin DoDot:2
+41 ;Default svc based on the dss id
+42 ;any TELEphone
IF $PIECE(^DIC(40.7,+VSIT("DSS"),0),"^",1)["TELE"
SET VSIT("SVC")="T"
+43 IF '$TEST
IF $ORDER(^VSIT(150.1,"B",+$PIECE(^DIC(40.7,+VSIT("DSS"),0),"^",2),0))
SET VSIT("SVC")="X"
+44 IF '$TEST
IF VSIT("SVC")=""
IF VSIT("DSS")=$PIECE($GET(^SC(+VSIT("LOC"),0)),"^",7)
SET VSIT("SVC")="A"
End DoDot:2
+45 IF VSIT("SVC")=""
SET VSIT("SVC")="X"
End DoDot:1
+46 IF VSIT("IO")
Begin DoDot:1
+47 IF VSIT("SVC")="A"
SET VSIT("SVC")="I"
+48 IF '$TEST
IF VSIT("SVC")="X"
SET VSIT("SVC")="D"
End DoDot:1
+49 IF '$TEST
Begin DoDot:1
+50 IF VSIT("SVC")="I"
SET VSIT("SVC")="A"
+51 IF '$TEST
IF VSIT("SVC")="D"
SET VSIT("SVC")="X"
End DoDot:1
+52 SET VSIT("SVC")=$$ERRCHK^VSITCK("SVC",VSIT("SVC"))
+53 IF $LENGTH(VSIT("SVC"),"^")>1
DO ERR^VSITPUT($PIECE(VSIT("SVC"),"^",2,99))
SET QUIT=1
+54 ;
+55 QUIT QUIT
+56 ;
DEFAULTS ;Default all of the rest of the fields that are NOT need for lookup matching
+1 ; - CDT & MDT
+2 Begin DoDot:1
+3 NEW %,%H,%I,X
+4 DO NOW^%DTC
+5 SET (VSIT("CDT"),VSIT("MDT"))=%
End DoDot:1
+6 ; - LNK
+7 ; check if good
+8 if VSIT("LNK")]""
Begin DoDot:1
+9 SET VSIT("LNK")=$$GET^VSITVAR("LNK",VSIT("LNK"))
+10 IF +VSIT("LNK")
IF +VSIT("PAT")
Begin DoDot:2
+11 SET NOD=$GET(^AUPNVSIT(+VSIT("LNK"),0))
+12 ; delete flag
if +$PIECE(NOD,"^",11)
SET VSIT("LNK")=""
+13 ; different patients
if +VSIT("PAT")'=$PIECE(NOD,"^",5)
SET VSIT("LNK")=""
End DoDot:2
End DoDot:1
+14 SET VSIT("LNK")=$$ERRCHK^VSITCK("LNK",VSIT("LNK"))
+15 if $LENGTH(VSIT("LNK"),"^")>1
DO WRN^VSITPUT($PIECE(VSIT("LNK"),"^",2,99))
+16 ; - COD
+17 SET VSIT("COD")=$$ERRCHK^VSITCK("COD",VSIT("COD"))
+18 if $LENGTH(VSIT("COD"),"^")>1
DO WRN^VSITPUT($PIECE(VSIT("COD"),"^",2,99))
+19 ; - ELG
+20 IF +VSIT("PAT")
IF $FIND(VSIT(0),"I")!($FIND(VSIT(0),"E"))
Begin DoDot:1
+21 if VSIT(0)["I"
SET VSIT("ELG")=$$ELG^VSITASK(VSIT("PAT"))
+22 if VSIT("ELG")=""
Begin DoDot:2
+23 ;Eligibility Code form Parent Visit
if VSIT("LNK")>0
SET VSIT("ELG")=$PIECE($GET(^AUPNVSIT(VSIT("LNK"),0)),"^",21)
+24 ;Primary Eligibility Code
if VSIT("ELG")=""
SET VSIT("ELG")=$PIECE($GET(^DPT(+VSIT("PAT"),.36)),"^")
+25 if VSIT("ELG")=""
Begin DoDot:3
+26 NEW VSITI,VSITE
+27 SET (VSITI,VSITE)=0
+28 ;See if any eligibilities it the Patient Eigibilities sub-file
+29 FOR
SET VSITE=$ORDER(^DPT(+VSIT("PAT"),"E",VSITE))
if VSITE'>0
QUIT
SET VSITI=VSITI+1
+30 ;If only one use it
IF VSITI=1
SET VSIT("ELG")=$ORDER(^DPT(+VSIT("PAT"),"E",0))
End DoDot:3
End DoDot:2
End DoDot:1
+31 SET VSIT("ELG")=$$ERRCHK^VSITCK("ELG",VSIT("ELG"))
+32 if $LENGTH(VSIT("ELG"),"^")>1
DO WRN^VSITPUT($PIECE(VSIT("ELG"),"^",2,99))
+33 ; - USR
+34 IF VSIT("USR")=""
IF +$GET(DUZ)
SET VSIT("USR")=+DUZ
+35 SET VSIT("USR")=$$ERRCHK^VSITCK("USR",VSIT("USR"))
+36 if $LENGTH(VSIT("USR"),"^")>1
DO WRN^VSITPUT($PIECE(VSIT("USR"),"^",2,99))
+37 ; - OPT
+38 if VSIT("OPT")=""
SET VSIT("OPT")=$PIECE($GET(XQY),"^")
+39 SET VSIT("OPT")=$$ERRCHK^VSITCK("OPT",VSIT("OPT"))
+40 if $LENGTH(VSIT("OPT"),"^")>1
DO WRN^VSITPUT($PIECE(VSIT("OPT"),"^",2,99))
+41 ; - PRO
+42 IF VSIT("PRO")=""
IF $PIECE($GET(XQORNOD),";",2)="ORD(101,"
SET VSIT("PRO")=$PIECE($GET(XQORNOD),";")
+43 SET VSIT("PRO")=$$ERRCHK^VSITCK("PRO",VSIT("PRO"))
+44 if $LENGTH(VSIT("PRO"),"^")>1
DO WRN^VSITPUT($PIECE(VSIT("PRO"),"^",2,99))
+45 ; - OUT
+46 SET VSIT("OUT")=$$ERRCHK^VSITCK("OUT",VSIT("OUT"))
+47 if $LENGTH(VSIT("OUT"),"^")>1
DO WRN^VSITPUT($PIECE(VSIT("OUT"),"^",2,99))
+48 ; - VID
+49 SET VSIT("VID")=$$GETVID^VSITVID
+50 ; - PRI
+51 IF VSIT("PRI")="P"
IF $ORDER(^VSIT(150.1,"B",+$PIECE($GET(^DIC(40.7,+VSIT("DSS"),0)),"^",2),0))
SET VSIT("PRI")="O"
+52 SET VSIT("PRI")=$$ERRCHK^VSITCK("PRI",VSIT("PRI"))
+53 if $LENGTH(VSIT("PRI"),"^")>1
DO WRN^VSITPUT($PIECE(VSIT("PRI"),"^",2,99))
+54 ; - SC
+55 SET VSIT("SC")=$$ERRCHK^VSITCK("SC",VSIT("SC"))
+56 if $LENGTH(VSIT("SC"),"^")>1
DO WRN^VSITPUT($PIECE(VSIT("SC"),"^",2,99))
+57 ; - AO
+58 SET VSIT("AO")=$$ERRCHK^VSITCK("AO",VSIT("AO"))
+59 if $LENGTH(VSIT("AO"),"^")>1
DO WRN^VSITPUT($PIECE(VSIT("AO"),"^",2,99))
+60 ; - IR
+61 SET VSIT("IR")=$$ERRCHK^VSITCK("IR",VSIT("IR"))
+62 if $LENGTH(VSIT("IR"),"^")>1
DO WRN^VSITPUT($PIECE(VSIT("IR"),"^",2,99))
+63 ; - EC
+64 SET VSIT("EC")=$$ERRCHK^VSITCK("EC",VSIT("EC"))
+65 if $LENGTH(VSIT("EC"),"^")>1
DO WRN^VSITPUT($PIECE(VSIT("EC"),"^",2,99))
+66 ; - HNC - PX*1*111 - Head & Neck
+67 SET VSIT("HNC")=$$ERRCHK^VSITCK("HNC",VSIT("HNC"))
+68 if $LENGTH(VSIT("HNC"),"^")>1
DO WRN^VSITPUT($PIECE(VSIT("HNC"),"^",2,99))
+69 ; - CV - PX*1*130 - Combat Vet
+70 SET VSIT("CV")=$$ERRCHK^VSITCK("CV",VSIT("CV"))
+71 if $LENGTH(VSIT("CV"),"^")>1
DO WRN^VSITPUT($PIECE(VSIT("CV"),"^",2,99))
+72 ; - SHAD - PX*1*168 - Project 112/SHAD
+73 SET VSIT("SHAD")=$$ERRCHK^VSITCK("SHAD",VSIT("SHAD"))
+74 if $LENGTH(VSIT("SHAD"),"^")>1
DO WRN^VSITPUT($PIECE(VSIT("SHAD"),"^",2,99))
+75 ; - COM
+76 SET VSIT("COM")=$$ERRCHK^VSITCK("COM",VSIT("COM"))
+77 if $LENGTH(VSIT("COM"),"^")>1
DO WRN^VSITPUT($PIECE(VSIT("COM"),"^",2,99))
+78 ; - VER
+79 SET VSIT("VER")=$$ERRCHK^VSITCK("VER",VSIT("VER"))
+80 if $LENGTH(VSIT("VER"),"^")>1
DO WRN^VSITPUT($PIECE(VSIT("VER"),"^",2,99))
+81 ; - PKG
+82 SET VSIT("PKG")=$$PKG2IEN^VSIT(VSIT("PKG"))
+83 SET VSIT("PKG")=$$ERRCHK^VSITCK("PKG",VSIT("PKG"))
+84 if $LENGTH(VSIT("PKG"),"^")>1
DO WRN^VSITPUT($PIECE(VSIT("PKG"),"^",2,99))
+85 ; - SOR
+86 ;Lookup source in PCE DATA SOURCE file (#839.7) with LAYGO
+87 IF VSIT("SOR")'=+VSIT("SOR")
Begin DoDot:1
+88 IF $TEXT(SOURCE^PXAPI)=""
Begin DoDot:2
+89 SET VSIT("SOR")=$$SOURCE^PXAPI(VSIT("SOR"))
End DoDot:2
+90 IF '$TEST
SET VSIT("SOR")=""
End DoDot:1
+91 SET VSIT("SOR")=$$ERRCHK^VSITCK("SOR",VSIT("SOR"))
+92 if $LENGTH(VSIT("SOR"),"^")>1
DO WRN^VSITPUT($PIECE(VSIT("SOR"),"^",2,99))
+93 ;
+94 ;PFSS Patient Reference
+95 SET VSIT("ACT")=$$ERRCHK^VSITCK("ACT",VSIT("ACT"))
+96 IF $$SWSTAT^IBBAPI()
if $LENGTH(VSIT("ACT"),"^")>1
DO WRN^VSITPUT($PIECE(VSIT("ACT"),"^",2,99))
+97 QUIT
+98 ;
