BLRPCCVC.m

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