BLRPCCVC ;IHS/OIT/MKK - IHS LAB LINK TO PCC ; 11-Apr-2016 07:53 ; MKK
;;5.2;IHS LABORATORY;**1022,1024,1025,1027,1033,1039**;NOV 01, 1997;Build 38
;
; Create BLRAPI4 INPUT array so that call to GETVISIT^APCDAPI4 will have
; valid INPUT variables.
EP ; EP
K BLRAPI4 ; Initialize the array
NEW OUT,SCIEN,TODAY,USER,VISITDT
;
S BLRAPI4("NEVER ADD")=1 ; Try to find PCC Visit first
;
; ----- BEGIN IHS/OIT/MKK LR*5.2*1024 MODIFICATIONS
S BLRAPI4("ANCILLARY")=1 ; Create Noon Visit
; ----- END IHS/OIT/MKK LR*5.2*1024 MODIFICATIONS
;
S BLRAPI4("PAT")=APCDALVR("APCDPAT") ; Patient IEN
;
S TODAY=$P($$NOW^XLFDT,".",1) ; Today -- Date only
;
; If order is today, then use Order Date/Time to try to match
I $P($G(BLRODT),".",1)=TODAY S VISITDT=BLRODT
; Use Collection Date/Time if Order Date/Time not today
I $P($G(BLRODT),".",1)'=TODAY S VISITDT=$G(BLRCDT)
;
; ----- BEGIN IHS/OIT/MKK LR*5.2*1025 MODIFICATIONS
; Use Collection Date/Time if FAST BYPASS option selected
I $$UP^XLFSTR($G(BLROPT))["FASTORD" S VISITDT=$G(BLRCDT)
; ----- END IHS/OIT/MKK LR*5.2*1025 MODIFICATIONS
;
; Use NOW if no Collection Date/Time and Order Date/Time not today
I $G(BLRCDT)=""&($P($G(BLRODT),".",1)'=TODAY) S VISITDT=$$NOW^XLFDT
;
; ----- BEGIN IHS/OIT/MKK LR*5.2*1039 MODIFICATIONS
; If the BLR COLL DT PCC VISIT CREATION parameter is set, then use the
; Collection Date for Visit Creation.
I +$$GET^XPAR("PKG","BLR COLL DT PCC VISIT CREATION",1,"Q") S VISITDT=$G(BLRCDT,VISITDT)
; ----- END IHS/OIT/MKK LR*5.2*1039 MODIFICATIONS
;
S BLRAPI4("VISIT DATE")=VISITDT
;
I +$G(BLRORDL1)>0 S BLRAPI4("SITE")=BLRORDL1 ; Order site
;
; If no Order Site
I +$G(BLRORDL1)<1 D
. I +$G(BLRQSITE)>0 S BLRAPI4("SITE")=+$G(BLRQSITE) ; Default
. I +$G(BLRQSITE)<1 S BLRAPI4("SITE")=+$G(DUZ(2)) ; User's Site
;
; VISIT TYPE stored in PCC MASTER CONTROL file in the
; "type of visit" field
S BLRAPI4("VISIT TYPE")=$P($G(^APCCCTRL(DUZ(2),0)),"^",4)
;
; Service Category IEN
S BLRAPI4("SRV CAT")=$G(BLRVCAT)
S BLRAPI4("TIME RANGE")=-1 ; Don't use Time Range
;
; Try to determine the user who entered the data
I +$G(BLRLOGDA)>0 S USER=$P($G(^BLRTXLOG(BLRLOGDA,20)),"^",6)
I +$G(USER)<1 S USER=$G(BLRDUZ) ; IHS/OIT/MKK MODIFICATIONS LR*5.2*1027
I +$G(USER)<1 S USER=DUZ
S BLRAPI4("USR")=USER
;
; Optional - Provider (Dict 200), if possible
S:+$G(BLROPRV)>0 BLRAPI4("PROVIDER")=BLROPRV
;
; Optional - Set Hospital Location (Dict. 44), if possible
S:+$G(BLRORDL)>0 BLRAPI4("HOS LOC")=BLRORDL
S:+$G(BLRORDL)<1&(+$G(ORDLOC)>0) BLRAPI4("HOS LOC")=ORDLOC
;
; Optional - Default Clinic Code (Dict 40.7), if possible
S:$G(BLRCLIN)'="" BLRAPI4("CLINIC CODE")=$P(BLRCLIN,"`",2)
;
Q
;
; ----- BEGIN IHS/OIT/MKK LR*5.2*1027
; PCC VISIT -- VISIT CREATED BY field is populated by the DUZ.
; LOC. OF ENCOUNTER field is populated by DUZ(2)
RESETDUZ ; EP
NEW USER,TSTR,NEWDUZ2,TMPORD,TMP1,TMP2
;
; If ^BLRTXLOG Txn # existent, try VERIFIER field
S USER=$P($G(^BLRTXLOG(+$G(BLRLOGDA),20)),"^",6)
I +$G(USER)>0 D Q
. S TSTR="DUZ"_"=USER"
. S @TSTR
. D RESETDZ2
;
; If still not changed
S USER=$P($G(^LRO(68,+$G(BLRAA),1,+$G(BLRAD),1,+$G(BLRAN),0)),"^",10)
I +$G(USER)<1 Q
;
S TSTR="DUZ"_"=USER"
S @TSTR
;
D RESETDZ2
;
Q
;
RESETDZ2 ; EP -- Reset DUZ(2), if possible
NEW REDO
;
S NEWDUZ2=$P($G(^BLRTXLOG(+$G(BLRLOGDA),0)),"^",9)
S REDO="DUZ(2)"_"=NEWDUZ2"
I $G(NEWDUZ2)'="" S @REDO Q
;
; If possible, reset DUZ(2) to Order Site
S REDO="DUZ(2)"_"=BLRORDL1"
I +$G(BLRORDL1)>0 S @REDO Q
;
; If still not reset, try default
S REDO="DUZ(2)"_"=BLRQSITE"
I +$G(BLRQSITE)>0 S @REDO
;
Q
; ----- END IHS/OIT/MKK LR*5.2*1027
BLRPCCVC ;IHS/OIT/MKK - IHS LAB LINK TO PCC ; 11-Apr-2016 07:53 ; MKK
+1 ;;5.2;IHS LABORATORY;**1022,1024,1025,1027,1033,1039**;NOV 01, 1997;Build 38
+2 ;
+3 ; Create BLRAPI4 INPUT array so that call to GETVISIT^APCDAPI4 will have
+4 ; valid INPUT variables.
EP ; EP
+1 ; Initialize the array
KILL BLRAPI4
+2 NEW OUT,SCIEN,TODAY,USER,VISITDT
+3 ;
+4 ; Try to find PCC Visit first
SET BLRAPI4("NEVER ADD")=1
+5 ;
+6 ; ----- BEGIN IHS/OIT/MKK LR*5.2*1024 MODIFICATIONS
+7 ; Create Noon Visit
SET BLRAPI4("ANCILLARY")=1
+8 ; ----- END IHS/OIT/MKK LR*5.2*1024 MODIFICATIONS
+9 ;
+10 ; Patient IEN
SET BLRAPI4("PAT")=APCDALVR("APCDPAT")
+11 ;
+12 ; Today -- Date only
SET TODAY=$PIECE($$NOW^XLFDT,".",1)
+13 ;
+14 ; If order is today, then use Order Date/Time to try to match
+15 IF $PIECE($GET(BLRODT),".",1)=TODAY
SET VISITDT=BLRODT
+16 ; Use Collection Date/Time if Order Date/Time not today
+17 IF $PIECE($GET(BLRODT),".",1)'=TODAY
SET VISITDT=$GET(BLRCDT)
+18 ;
+19 ; ----- BEGIN IHS/OIT/MKK LR*5.2*1025 MODIFICATIONS
+20 ; Use Collection Date/Time if FAST BYPASS option selected
+21 IF $$UP^XLFSTR($GET(BLROPT))["FASTORD"
SET VISITDT=$GET(BLRCDT)
+22 ; ----- END IHS/OIT/MKK LR*5.2*1025 MODIFICATIONS
+23 ;
+24 ; Use NOW if no Collection Date/Time and Order Date/Time not today
+25 IF $GET(BLRCDT)=""&($PIECE($GET(BLRODT),".",1)'=TODAY)
SET VISITDT=$$NOW^XLFDT
+26 ;
+27 ; ----- BEGIN IHS/OIT/MKK LR*5.2*1039 MODIFICATIONS
+28 ; If the BLR COLL DT PCC VISIT CREATION parameter is set, then use the
+29 ; Collection Date for Visit Creation.
+30 IF +$$GET^XPAR("PKG","BLR COLL DT PCC VISIT CREATION",1,"Q")
SET VISITDT=$GET(BLRCDT,VISITDT)
+31 ; ----- END IHS/OIT/MKK LR*5.2*1039 MODIFICATIONS
+32 ;
+33 SET BLRAPI4("VISIT DATE")=VISITDT
+34 ;
+35 ; Order site
IF +$GET(BLRORDL1)>0
SET BLRAPI4("SITE")=BLRORDL1
+36 ;
+37 ; If no Order Site
+38 IF +$GET(BLRORDL1)<1
Begin DoDot:1
+39 ; Default
IF +$GET(BLRQSITE)>0
SET BLRAPI4("SITE")=+$GET(BLRQSITE)
+40 ; User's Site
IF +$GET(BLRQSITE)<1
SET BLRAPI4("SITE")=+$GET(DUZ(2))
End DoDot:1
+41 ;
+42 ; VISIT TYPE stored in PCC MASTER CONTROL file in the
+43 ; "type of visit" field
+44 SET BLRAPI4("VISIT TYPE")=$PIECE($GET(^APCCCTRL(DUZ(2),0)),"^",4)
+45 ;
+46 ; Service Category IEN
+47 SET BLRAPI4("SRV CAT")=$GET(BLRVCAT)
+48 ; Don't use Time Range
SET BLRAPI4("TIME RANGE")=-1
+49 ;
+50 ; Try to determine the user who entered the data
+51 IF +$GET(BLRLOGDA)>0
SET USER=$PIECE($GET(^BLRTXLOG(BLRLOGDA,20)),"^",6)
+52 ; IHS/OIT/MKK MODIFICATIONS LR*5.2*1027
IF +$GET(USER)<1
SET USER=$GET(BLRDUZ)
+53 IF +$GET(USER)<1
SET USER=DUZ
+54 SET BLRAPI4("USR")=USER
+55 ;
+56 ; Optional - Provider (Dict 200), if possible
+57 IF +$GET(BLROPRV)>0
SET BLRAPI4("PROVIDER")=BLROPRV
+58 ;
+59 ; Optional - Set Hospital Location (Dict. 44), if possible
+60 IF +$GET(BLRORDL)>0
SET BLRAPI4("HOS LOC")=BLRORDL
+61 IF +$GET(BLRORDL)<1&(+$GET(ORDLOC)>0)
SET BLRAPI4("HOS LOC")=ORDLOC
+62 ;
+63 ; Optional - Default Clinic Code (Dict 40.7), if possible
+64 IF $GET(BLRCLIN)'=""
SET BLRAPI4("CLINIC CODE")=$PIECE(BLRCLIN,"`",2)
+65 ;
+66 QUIT
+67 ;
+68 ; ----- BEGIN IHS/OIT/MKK LR*5.2*1027
+69 ; PCC VISIT -- VISIT CREATED BY field is populated by the DUZ.
+70 ; LOC. OF ENCOUNTER field is populated by DUZ(2)
RESETDUZ ; EP
+1 NEW USER,TSTR,NEWDUZ2,TMPORD,TMP1,TMP2
+2 ;
+3 ; If ^BLRTXLOG Txn # existent, try VERIFIER field
+4 SET USER=$PIECE($GET(^BLRTXLOG(+$GET(BLRLOGDA),20)),"^",6)
+5 IF +$GET(USER)>0
Begin DoDot:1
+6 SET TSTR="DUZ"_"=USER"
+7 SET @TSTR
+8 DO RESETDZ2
End DoDot:1
QUIT
+9 ;
+10 ; If still not changed
+11 SET USER=$PIECE($GET(^LRO(68,+$GET(BLRAA),1,+$GET(BLRAD),1,+$GET(BLRAN),0)),"^",10)
+12 IF +$GET(USER)<1
QUIT
+13 ;
+14 SET TSTR="DUZ"_"=USER"
+15 SET @TSTR
+16 ;
+17 DO RESETDZ2
+18 ;
+19 QUIT
+20 ;
RESETDZ2 ; EP -- Reset DUZ(2), if possible
+1 NEW REDO
+2 ;
+3 SET NEWDUZ2=$PIECE($GET(^BLRTXLOG(+$GET(BLRLOGDA),0)),"^",9)
+4 SET REDO="DUZ(2)"_"=NEWDUZ2"
+5 IF $GET(NEWDUZ2)'=""
SET @REDO
QUIT
+6 ;
+7 ; If possible, reset DUZ(2) to Order Site
+8 SET REDO="DUZ(2)"_"=BLRORDL1"
+9 IF +$GET(BLRORDL1)>0
SET @REDO
QUIT
+10 ;
+11 ; If still not reset, try default
+12 SET REDO="DUZ(2)"_"=BLRQSITE"
+13 IF +$GET(BLRQSITE)>0
SET @REDO
+14 ;
+15 QUIT
+16 ; ----- END IHS/OIT/MKK LR*5.2*1027
