ACKQPCE1 ;HCIOFO/AG - Quasar/PCE Interface; August 1999. ;20 Nov 2013 4:40 PM
;;3.0;QUASAR;**1,2,5,7,8,16,21**;Feb 11, 2000;Build 40
;
; Reference/IA
; $$CSI^ICDEX - 5747
;
; this routine contains the code for sending a Quasar visit to PCE
; it is called from ACKQPCE.
;
SENDPCE(ACKVIEN,ACKPKG,ACKSRC) ; send a Quasar Visit to PCE.
; see SENDPCE^ACKQPCE for entry parameters and processing notes.
; this routine should not be called directly, only from ACKQPCE
; (this routine assumes all the entry parameters are passed!)
N %,ACKCLN,ACKE2,ACKSENT,ACKLOCK,ACKRSN,ACKMSG,ACKFDA,ACKFDA2,ACKPCE,ACKE,ACKERR,ACKNARR
N ACKVDT,ACKVTM,ACKPAT,ACKSC,ACKAO,ACKIR,ACKEC,ACKCHKDT,ACKELIG,ACKPROCP
N ACKVSC,ACKCAT,ACKAPI,ACKCT,ACKMST,ACKPRIM,ACKSCND,ACKSTUD,ACKIEN,ACKICD9
N ACKCPT,ACKVOL,ACKIEN2,ACKMOD,ACKPROB,ACKARR,ACKDATE,ACKDPRIM,ACKK5,ACKHNC,ACKCV
; initialize
S ACKSENT=0,ACKLOCK=0,ACKERR=0
D NOW^%DTC S ACKDATE=% ; to be used for LAST SENT TO PCE field
;
; lock the visit
L +^ACK(509850.6,ACKVIEN):$G(DILOCKTM,3) S ACKLOCK=$T
; if unable to lock then exit
I 'ACKLOCK G SENDPCEX
;
; initialize temp file
K ^TMP("ACKQPCE1",$J)
;
; remove PCE errors from the visit
D CLEAR^ACKQPCE(ACKVIEN)
;
; get the visit data and place in temp file
D GETDATA
;
; if this visit exists in PCE then remove workload data
D CHKPCE I ACKERR G SENDPCEX
;
; build the temp file for sending to PCE
D BUILD
;
; now send
D SENDIT
;
SENDPCEX ; exit point
;
; if visit was locked, unlock it
I ACKLOCK L -^ACK(509850.6,ACKVIEN)
;
; clear the temp file
;K ^TMP("ACKQPCE1",$J)
;
; return
Q ACKSENT
;
GETDATA ; get the visit data and place in temp file
S ACKFDA=$NA(^TMP("ACKQPCE1",$J,"FDA"))
D GETS^DIQ(509850.6,ACKVIEN_",","**","I",ACKFDA,"")
S ACKFDA2=$NA(^TMP("ACKQPCE1",$J,"FDA",509850.6,ACKVIEN_","))
; data now stored in ..
; ^TMP("ACKQPCE1",$J,"FDA",509850.6,visit_",",fldnum,"I")=internal value
; simplified to @ACKFDA2@(fldnum,"I")=internal value
; get the PCE visit ien
S ACKPCE=@ACKFDA2@(125,"I")
; get the visit date and time, patient and clinic
S ACKVDT=@ACKFDA2@(.01,"I")
S ACKVTM=@ACKFDA2@(55,"I")
S ACKPAT=@ACKFDA2@(1,"I")
S ACKCLN=@ACKFDA2@(2.6,"I")
; end of getdata
Q
;
CHKPCE ; check if the visit is already in PCE and remove workload if it is
I 'ACKPCE Q
;
; check PCE visit is for same Patient, Clinic, Date and Time
; if any item different then this Qsr visit is treated as new
; and any data from Quasar is deleted from the original PCE visit
; (sending ACKPKG and ACKSRC ensures that only data that originally
; came from Quasar will be removed).
I +$$PCECHK^ACKQUTL3(ACKPCE,ACKVDT,ACKVTM,ACKPAT,ACKCLN)'=2 D Q
. S ACKE=$$DELVFILE^PXAPI("ALL",ACKPCE,ACKPKG,ACKSRC,0,0,"")
. S ACKPCE="" ; remove PCE Visit ien from Qsr visit
. K ACKARR S ACKARR(509850.6,ACKVIEN_",",125)="@"
. D FILE^DIE("","ACKARR","")
;
; remove all workload data from the PCE visit
S ACKE=$$DELVFILE^PXAPI("CPT^POV^PRV^VISIT",ACKPCE,"","",0,0,"")
S ACKERR=$S(ACKE>-1:0,ACKE=-4:0,1:1)
;
; if error occurred then store on visit file
I ACKERR D Q
. K ACKRSN S ACKMSG="Unable to delete original PCE visit data (error code="_ACKE_")"
. D ADDRSN^ACKQPCE2("PCE VISIT",ACKPCE,"",ACKMSG,.ACKRSN)
. D FILERSN^ACKQPCE(ACKVIEN,.ACKRSN) ; file errors on visit file
;
; if no error, check to see if the entire PCE visit has been deleted
; and if so, blank out the PCE Visit ien variable so that a new one
; can be allocated.
K ^TMP("PXKENC",$J)
D ENCEVENT^PXAPI(ACKPCE)
I '$D(^TMP("PXKENC",$J,ACKPCE)) D
. K ACKARR S ACKARR(509850.6,ACKVIEN_",",125)="@"
. D FILE^DIE("","ACKARR","")
. S ACKPCE=""
K ^TMP("PXKENC",$J)
;
; return
Q
;
;
BUILD ; now build array for passing data to PCE
K ^TMP("ACKQPCE1",$J,"PXAPI")
S ACKAPI=$NA(^TMP("ACKQPCE1",$J,"PXAPI"))
;
; ----------encounter date/time----------------
S @ACKAPI@("ENCOUNTER",1,"ENC D/T")=(ACKVDT\1+ACKVTM)
; --------------patient-----------------------
S @ACKAPI@("ENCOUNTER",1,"PATIENT")=ACKPAT
; ---------------clinic-----------------------
S @ACKAPI@("ENCOUNTER",1,"HOS LOC")=ACKCLN
; ------------service connected---------------
S ACKSC=@ACKFDA2@(20,"I")
S @ACKAPI@("ENCOUNTER",1,"SC")=ACKSC
; -------------agent orange,MST etc---------------
S ACKAO=@ACKFDA2@(25,"I")
S @ACKAPI@("ENCOUNTER",1,"AO")=ACKAO
S ACKIR=@ACKFDA2@(30,"I")
S @ACKAPI@("ENCOUNTER",1,"IR")=ACKIR
S ACKEC=@ACKFDA2@(35,"I")
S @ACKAPI@("ENCOUNTER",1,"EC")=ACKEC
S ACKMST=@ACKFDA2@(90,"I")
S @ACKAPI@("ENCOUNTER",1,"MST")=ACKMST
S ACKHNC=@ACKFDA2@(40,"I")
S @ACKAPI@("ENCOUNTER",1,"HNC")=ACKHNC
S ACKCV=@ACKFDA2@(45,"I")
S @ACKAPI@("ENCOUNTER",1,"CV")=ACKCV
; -------------checkout date/time-------------
D NOW^%DTC S ACKCHKDT=%
S @ACKAPI@("ENCOUNTER",1,"CHECKOUT D/T")=ACKCHKDT
; -------------visit eligibility--------------
S ACKELIG=@ACKFDA2@(80,"I")
S @ACKAPI@("ENCOUNTER",1,"ELIGIBILITY")=ACKELIG
; --------------service category--------------
S ACKVSC=@ACKFDA2@(4,"I")
S ACKCAT=$S(ACKVSC="AT":"T",ACKVSC="ST":"T",1:"X")
S @ACKAPI@("ENCOUNTER",1,"SERVICE CATEGORY")=ACKCAT
; ---------------encounter type---------------
S @ACKAPI@("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
;
S ACKCT=0
; ------------secondary provider-------------
S ACKK5=""
F S ACKK5=$O(^TMP("ACKQPCE1",$J,"FDA",509850.66,ACKK5)) Q:ACKK5="" D
. I $P(ACKK5,",",2)'=ACKVIEN Q
. S ACKSCND=$G(^TMP("ACKQPCE1",$J,"FDA",509850.66,ACKK5,".01","I"))
. I ACKSCND="" Q
. S ACKSCND=$$CONVERT1^ACKQUTL4(ACKSCND)
. S ACKCT=ACKCT+1,@ACKAPI@("PROVIDER",ACKCT,"NAME")=ACKSCND
; ------------primary provider----------------
S ACKPRIM=@ACKFDA2@(6,"I")
I ACKPRIM'="" D
. S ACKPRIM=$$CONVERT1^ACKQUTL4(ACKPRIM)
. S ACKCT=ACKCT+1,@ACKAPI@("PROVIDER",ACKCT,"NAME")=ACKPRIM
. S @ACKAPI@("PROVIDER",ACKCT,"PRIMARY")=1
;
; ----------------diagnosis------------------
N ACKPBLM,ACKPBLMP,ACKIFN,ACKPLQT,ACKICD
S ACKCT=0,(ACKIEN,ACKDPRIM,ACKNARR,ACKPBLM,ACKPBLMP)=""
F S ACKIEN=$O(@ACKFDA@(509850.63,ACKIEN)) Q:ACKIEN="" D
. I $P(ACKIEN,",",2)'=ACKVIEN Q
. S ACKICD9=@ACKFDA@(509850.63,ACKIEN,.01,"I")
. S ACKCT=ACKCT+1,@ACKAPI@("DX/PL",ACKCT,"DIAGNOSIS")=ACKICD9
. S ACKICD=$$CSI^ICDEX(80,ACKICD9) ;CLA
. S ACKNARR=$$LDIAGTXT^ACKQUTL8(ACKICD9,ACKVD,ACKICD) ;CLA
. I ACKNARR'="" S @ACKAPI@("DX/PL",ACKCT,"NARRATIVE")=ACKNARR
. ; check for updating PCE problem list flag
. S ACKPBLM=@ACKFDA@(509850.63,ACKIEN,.13,"I") I ACKPBLM D
. . ; don't send if diagnosis provider blank
. . S ACKPBLMP=@ACKFDA@(509850.63,ACKIEN,.14,"I") Q:'ACKPBLMP
. . S ACKPLQT=$$PLIST^ACKQUTL6(ACKPAT,ACKICD9)
. . ; send new problem if not on list
. . I 'ACKPLQT S @ACKAPI@("DX/PL",ACKCT,"PL ADD")=1
. . ; make existing problem active if currently inactive
. . I +ACKPLQT=1 D
. . . S @ACKAPI@("DX/PL",ACKCT,"PL IEN")=$P(ACKPLQT,U,2)
. . . S @ACKAPI@("DX/PL",ACKCT,"PL ACTIVE")="A"
. . ; send event date and encounter provider if updating list
. . I +ACKPLQT'=2 D
. . . S @ACKAPI@("DX/PL",ACKCT,"EVENT D/T")=ACKVD
. . . S ACKPBLMP=$$CONVERT1^ACKQUTL4(ACKPBLMP)
. . . S @ACKAPI@("DX/PL",ACKCT,"ENC PROVIDER")=ACKPBLMP
. ; Check for primary diagnosis
. I 'ACKDPRIM,@ACKFDA@(509850.63,ACKIEN,.12,"I")=1 D
. . S @ACKAPI@("DX/PL",ACKCT,"PRIMARY")=1
. . S ACKDPRIM=1
; First Diagnosis sent as Primary if No Primary defined on Visit file
I 'ACKDPRIM,ACKCT>0 S @ACKAPI@("DX/PL",1,"PRIMARY")=1
;
; -----------------procedures----------------
S ACKCT=0,ACKIEN="",ACKPROCP=""
F S ACKIEN=$O(@ACKFDA@(509850.61,ACKIEN)) Q:ACKIEN="" D
. I $P(ACKIEN,",",2)'=ACKVIEN Q
. S ACKCPT=@ACKFDA@(509850.61,ACKIEN,.01,"I") ; CPT IEN
. S ACKVOL=@ACKFDA@(509850.61,ACKIEN,.03,"I") ; Volume
. S ACKPROCP=@ACKFDA@(509850.61,ACKIEN,.05,"I") ; Provider
. I ACKPROCP'="" S ACKPROCP=$$CONVERT1^ACKQUTL4(ACKPROCP) ; Convert from QSR to Vista
. S ACKCT=ACKCT+1,@ACKAPI@("PROCEDURE",ACKCT,"PROCEDURE")=ACKCPT
. S @ACKAPI@("PROCEDURE",ACKCT,"QTY")=$S(ACKVOL:ACKVOL,1:1)
. I ACKPROCP'="" S @ACKAPI@("PROCEDURE",ACKCT,"ENC PROVIDER")=ACKPROCP
. ; --------------procedure modifiers-------------
. S ACKIEN2=""
. F S ACKIEN2=$O(@ACKFDA@(509850.64,ACKIEN2)) Q:ACKIEN2="" D
. . I $P(ACKIEN2,",",2,3)'=$P(ACKIEN,",",1,2) Q
. . S ACKMOD=@ACKFDA@(509850.64,ACKIEN2,.01,"I")
. . S ACKMOD=$$GET1^DIQ(509850.5,ACKMOD,.01,"E")
. . I $D(@ACKAPI@("PROCEDURE",ACKCT,"MODIFIERS"))#10=0 D
. . . S @ACKAPI@("PROCEDURE",ACKCT,"MODIFIERS")=""
. . S @ACKAPI@("PROCEDURE",ACKCT,"MODIFIERS",ACKMOD)=""
;
; end of build
Q
;
SENDIT ; send the data to PCE
K ACKPROB
;
; call the PCE package API
S ACKE=$$DATA2PCE^PXAPI($NA(^TMP("ACKQPCE1",$J,"PXAPI")),ACKPKG,ACKSRC,.ACKPCE,"",0,.ACKE2,"",.ACKPROB)
;
; check for returned error messages
K ACKRSN S ACKRSN=0
I $D(ACKPROB) D CONVERT^ACKQPCE2(.ACKPROB,ACKAPI,.ACKRSN)
;
; if update failed but no errors were returned then create a message
I ACKE'=1,'ACKRSN D
. S ACKMSG="Unable to update PCE Visit (error code="_ACKE_")"
. D ADDRSN^ACKQPCE2("PCE VISIT","","",ACKMSG,.ACKRSN)
. I ACKPCE'>0 D ; pce ien has been corrupted by the API
. . K ACKARR S ACKARR(509850.6,ACKVIEN_",",125)="@"
. . D FILE^DIE("","ACKARR","")
;
; if errors found then file them on the Visit file and create exception
I ACKE'=1,ACKRSN D
. D FILERSN^ACKQPCE(ACKVIEN,.ACKRSN)
. K ACKARR
. S ACKARR(509850.6,ACKVIEN_",",125)=ACKPCE ; for new visits!
. D FILE^DIE("","ACKARR","")
;
; if no errors update the PCE fields
I ACKE=1 D
. K ACKARR
. S ACKARR(509850.6,ACKVIEN_",",125)=ACKPCE ; for new visits!
. S ACKARR(509850.6,ACKVIEN_",",135)=ACKDATE ; date last sent
. D FILE^DIE("","ACKARR","")
. S ACKSENT=1 ; return flag (1=sent,0=not sent)
;
; end of sendit
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQPCE1 9948 printed Dec 13, 2024@02:32:23 Page 2
ACKQPCE1 ;HCIOFO/AG - Quasar/PCE Interface; August 1999. ;20 Nov 2013 4:40 PM
+1 ;;3.0;QUASAR;**1,2,5,7,8,16,21**;Feb 11, 2000;Build 40
+2 ;
+3 ; Reference/IA
+4 ; $$CSI^ICDEX - 5747
+5 ;
+6 ; this routine contains the code for sending a Quasar visit to PCE
+7 ; it is called from ACKQPCE.
+8 ;
SENDPCE(ACKVIEN,ACKPKG,ACKSRC) ; send a Quasar Visit to PCE.
+1 ; see SENDPCE^ACKQPCE for entry parameters and processing notes.
+2 ; this routine should not be called directly, only from ACKQPCE
+3 ; (this routine assumes all the entry parameters are passed!)
+4 NEW %,ACKCLN,ACKE2,ACKSENT,ACKLOCK,ACKRSN,ACKMSG,ACKFDA,ACKFDA2,ACKPCE,ACKE,ACKERR,ACKNARR
+5 NEW ACKVDT,ACKVTM,ACKPAT,ACKSC,ACKAO,ACKIR,ACKEC,ACKCHKDT,ACKELIG,ACKPROCP
+6 NEW ACKVSC,ACKCAT,ACKAPI,ACKCT,ACKMST,ACKPRIM,ACKSCND,ACKSTUD,ACKIEN,ACKICD9
+7 NEW ACKCPT,ACKVOL,ACKIEN2,ACKMOD,ACKPROB,ACKARR,ACKDATE,ACKDPRIM,ACKK5,ACKHNC,ACKCV
+8 ; initialize
+9 SET ACKSENT=0
SET ACKLOCK=0
SET ACKERR=0
+10 ; to be used for LAST SENT TO PCE field
DO NOW^%DTC
SET ACKDATE=%
+11 ;
+12 ; lock the visit
+13 LOCK +^ACK(509850.6,ACKVIEN):$GET(DILOCKTM,3)
SET ACKLOCK=$TEST
+14 ; if unable to lock then exit
+15 IF 'ACKLOCK
GOTO SENDPCEX
+16 ;
+17 ; initialize temp file
+18 KILL ^TMP("ACKQPCE1",$JOB)
+19 ;
+20 ; remove PCE errors from the visit
+21 DO CLEAR^ACKQPCE(ACKVIEN)
+22 ;
+23 ; get the visit data and place in temp file
+24 DO GETDATA
+25 ;
+26 ; if this visit exists in PCE then remove workload data
+27 DO CHKPCE
IF ACKERR
GOTO SENDPCEX
+28 ;
+29 ; build the temp file for sending to PCE
+30 DO BUILD
+31 ;
+32 ; now send
+33 DO SENDIT
+34 ;
SENDPCEX ; exit point
+1 ;
+2 ; if visit was locked, unlock it
+3 IF ACKLOCK
LOCK -^ACK(509850.6,ACKVIEN)
+4 ;
+5 ; clear the temp file
+6 ;K ^TMP("ACKQPCE1",$J)
+7 ;
+8 ; return
+9 QUIT ACKSENT
+10 ;
GETDATA ; get the visit data and place in temp file
+1 SET ACKFDA=$NAME(^TMP("ACKQPCE1",$JOB,"FDA"))
+2 DO GETS^DIQ(509850.6,ACKVIEN_",","**","I",ACKFDA,"")
+3 SET ACKFDA2=$NAME(^TMP("ACKQPCE1",$JOB,"FDA",509850.6,ACKVIEN_","))
+4 ; data now stored in ..
+5 ; ^TMP("ACKQPCE1",$J,"FDA",509850.6,visit_",",fldnum,"I")=internal value
+6 ; simplified to @ACKFDA2@(fldnum,"I")=internal value
+7 ; get the PCE visit ien
+8 SET ACKPCE=@ACKFDA2@(125,"I")
+9 ; get the visit date and time, patient and clinic
+10 SET ACKVDT=@ACKFDA2@(.01,"I")
+11 SET ACKVTM=@ACKFDA2@(55,"I")
+12 SET ACKPAT=@ACKFDA2@(1,"I")
+13 SET ACKCLN=@ACKFDA2@(2.6,"I")
+14 ; end of getdata
+15 QUIT
+16 ;
CHKPCE ; check if the visit is already in PCE and remove workload if it is
+1 IF 'ACKPCE
QUIT
+2 ;
+3 ; check PCE visit is for same Patient, Clinic, Date and Time
+4 ; if any item different then this Qsr visit is treated as new
+5 ; and any data from Quasar is deleted from the original PCE visit
+6 ; (sending ACKPKG and ACKSRC ensures that only data that originally
+7 ; came from Quasar will be removed).
+8 IF +$$PCECHK^ACKQUTL3(ACKPCE,ACKVDT,ACKVTM,ACKPAT,ACKCLN)'=2
Begin DoDot:1
+9 SET ACKE=$$DELVFILE^PXAPI("ALL",ACKPCE,ACKPKG,ACKSRC,0,0,"")
+10 ; remove PCE Visit ien from Qsr visit
SET ACKPCE=""
+11 KILL ACKARR
SET ACKARR(509850.6,ACKVIEN_",",125)="@"
+12 DO FILE^DIE("","ACKARR","")
End DoDot:1
QUIT
+13 ;
+14 ; remove all workload data from the PCE visit
+15 SET ACKE=$$DELVFILE^PXAPI("CPT^POV^PRV^VISIT",ACKPCE,"","",0,0,"")
+16 SET ACKERR=$SELECT(ACKE>-1:0,ACKE=-4:0,1:1)
+17 ;
+18 ; if error occurred then store on visit file
+19 IF ACKERR
Begin DoDot:1
+20 KILL ACKRSN
SET ACKMSG="Unable to delete original PCE visit data (error code="_ACKE_")"
+21 DO ADDRSN^ACKQPCE2("PCE VISIT",ACKPCE,"",ACKMSG,.ACKRSN)
+22 ; file errors on visit file
DO FILERSN^ACKQPCE(ACKVIEN,.ACKRSN)
End DoDot:1
QUIT
+23 ;
+24 ; if no error, check to see if the entire PCE visit has been deleted
+25 ; and if so, blank out the PCE Visit ien variable so that a new one
+26 ; can be allocated.
+27 KILL ^TMP("PXKENC",$JOB)
+28 DO ENCEVENT^PXAPI(ACKPCE)
+29 IF '$DATA(^TMP("PXKENC",$JOB,ACKPCE))
Begin DoDot:1
+30 KILL ACKARR
SET ACKARR(509850.6,ACKVIEN_",",125)="@"
+31 DO FILE^DIE("","ACKARR","")
+32 SET ACKPCE=""
End DoDot:1
+33 KILL ^TMP("PXKENC",$JOB)
+34 ;
+35 ; return
+36 QUIT
+37 ;
+38 ;
BUILD ; now build array for passing data to PCE
+1 KILL ^TMP("ACKQPCE1",$JOB,"PXAPI")
+2 SET ACKAPI=$NAME(^TMP("ACKQPCE1",$JOB,"PXAPI"))
+3 ;
+4 ; ----------encounter date/time----------------
+5 SET @ACKAPI@("ENCOUNTER",1,"ENC D/T")=(ACKVDT\1+ACKVTM)
+6 ; --------------patient-----------------------
+7 SET @ACKAPI@("ENCOUNTER",1,"PATIENT")=ACKPAT
+8 ; ---------------clinic-----------------------
+9 SET @ACKAPI@("ENCOUNTER",1,"HOS LOC")=ACKCLN
+10 ; ------------service connected---------------
+11 SET ACKSC=@ACKFDA2@(20,"I")
+12 SET @ACKAPI@("ENCOUNTER",1,"SC")=ACKSC
+13 ; -------------agent orange,MST etc---------------
+14 SET ACKAO=@ACKFDA2@(25,"I")
+15 SET @ACKAPI@("ENCOUNTER",1,"AO")=ACKAO
+16 SET ACKIR=@ACKFDA2@(30,"I")
+17 SET @ACKAPI@("ENCOUNTER",1,"IR")=ACKIR
+18 SET ACKEC=@ACKFDA2@(35,"I")
+19 SET @ACKAPI@("ENCOUNTER",1,"EC")=ACKEC
+20 SET ACKMST=@ACKFDA2@(90,"I")
+21 SET @ACKAPI@("ENCOUNTER",1,"MST")=ACKMST
+22 SET ACKHNC=@ACKFDA2@(40,"I")
+23 SET @ACKAPI@("ENCOUNTER",1,"HNC")=ACKHNC
+24 SET ACKCV=@ACKFDA2@(45,"I")
+25 SET @ACKAPI@("ENCOUNTER",1,"CV")=ACKCV
+26 ; -------------checkout date/time-------------
+27 DO NOW^%DTC
SET ACKCHKDT=%
+28 SET @ACKAPI@("ENCOUNTER",1,"CHECKOUT D/T")=ACKCHKDT
+29 ; -------------visit eligibility--------------
+30 SET ACKELIG=@ACKFDA2@(80,"I")
+31 SET @ACKAPI@("ENCOUNTER",1,"ELIGIBILITY")=ACKELIG
+32 ; --------------service category--------------
+33 SET ACKVSC=@ACKFDA2@(4,"I")
+34 SET ACKCAT=$SELECT(ACKVSC="AT":"T",ACKVSC="ST":"T",1:"X")
+35 SET @ACKAPI@("ENCOUNTER",1,"SERVICE CATEGORY")=ACKCAT
+36 ; ---------------encounter type---------------
+37 SET @ACKAPI@("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
+38 ;
+39 SET ACKCT=0
+40 ; ------------secondary provider-------------
+41 SET ACKK5=""
+42 FOR
SET ACKK5=$ORDER(^TMP("ACKQPCE1",$JOB,"FDA",509850.66,ACKK5))
if ACKK5=""
QUIT
Begin DoDot:1
+43 IF $PIECE(ACKK5,",",2)'=ACKVIEN
QUIT
+44 SET ACKSCND=$GET(^TMP("ACKQPCE1",$JOB,"FDA",509850.66,ACKK5,".01","I"))
+45 IF ACKSCND=""
QUIT
+46 SET ACKSCND=$$CONVERT1^ACKQUTL4(ACKSCND)
+47 SET ACKCT=ACKCT+1
SET @ACKAPI@("PROVIDER",ACKCT,"NAME")=ACKSCND
End DoDot:1
+48 ; ------------primary provider----------------
+49 SET ACKPRIM=@ACKFDA2@(6,"I")
+50 IF ACKPRIM'=""
Begin DoDot:1
+51 SET ACKPRIM=$$CONVERT1^ACKQUTL4(ACKPRIM)
+52 SET ACKCT=ACKCT+1
SET @ACKAPI@("PROVIDER",ACKCT,"NAME")=ACKPRIM
+53 SET @ACKAPI@("PROVIDER",ACKCT,"PRIMARY")=1
End DoDot:1
+54 ;
+55 ; ----------------diagnosis------------------
+56 NEW ACKPBLM,ACKPBLMP,ACKIFN,ACKPLQT,ACKICD
+57 SET ACKCT=0
SET (ACKIEN,ACKDPRIM,ACKNARR,ACKPBLM,ACKPBLMP)=""
+58 FOR
SET ACKIEN=$ORDER(@ACKFDA@(509850.63,ACKIEN))
if ACKIEN=""
QUIT
Begin DoDot:1
+59 IF $PIECE(ACKIEN,",",2)'=ACKVIEN
QUIT
+60 SET ACKICD9=@ACKFDA@(509850.63,ACKIEN,.01,"I")
+61 SET ACKCT=ACKCT+1
SET @ACKAPI@("DX/PL",ACKCT,"DIAGNOSIS")=ACKICD9
+62 ;CLA
SET ACKICD=$$CSI^ICDEX(80,ACKICD9)
+63 ;CLA
SET ACKNARR=$$LDIAGTXT^ACKQUTL8(ACKICD9,ACKVD,ACKICD)
+64 IF ACKNARR'=""
SET @ACKAPI@("DX/PL",ACKCT,"NARRATIVE")=ACKNARR
+65 ; check for updating PCE problem list flag
+66 SET ACKPBLM=@ACKFDA@(509850.63,ACKIEN,.13,"I")
IF ACKPBLM
Begin DoDot:2
+67 ; don't send if diagnosis provider blank
+68 SET ACKPBLMP=@ACKFDA@(509850.63,ACKIEN,.14,"I")
if 'ACKPBLMP
QUIT
+69 SET ACKPLQT=$$PLIST^ACKQUTL6(ACKPAT,ACKICD9)
+70 ; send new problem if not on list
+71 IF 'ACKPLQT
SET @ACKAPI@("DX/PL",ACKCT,"PL ADD")=1
+72 ; make existing problem active if currently inactive
+73 IF +ACKPLQT=1
Begin DoDot:3
+74 SET @ACKAPI@("DX/PL",ACKCT,"PL IEN")=$PIECE(ACKPLQT,U,2)
+75 SET @ACKAPI@("DX/PL",ACKCT,"PL ACTIVE")="A"
End DoDot:3
+76 ; send event date and encounter provider if updating list
+77 IF +ACKPLQT'=2
Begin DoDot:3
+78 SET @ACKAPI@("DX/PL",ACKCT,"EVENT D/T")=ACKVD
+79 SET ACKPBLMP=$$CONVERT1^ACKQUTL4(ACKPBLMP)
+80 SET @ACKAPI@("DX/PL",ACKCT,"ENC PROVIDER")=ACKPBLMP
End DoDot:3
End DoDot:2
+81 ; Check for primary diagnosis
+82 IF 'ACKDPRIM
IF @ACKFDA@(509850.63,ACKIEN,.12,"I")=1
Begin DoDot:2
+83 SET @ACKAPI@("DX/PL",ACKCT,"PRIMARY")=1
+84 SET ACKDPRIM=1
End DoDot:2
End DoDot:1
+85 ; First Diagnosis sent as Primary if No Primary defined on Visit file
+86 IF 'ACKDPRIM
IF ACKCT>0
SET @ACKAPI@("DX/PL",1,"PRIMARY")=1
+87 ;
+88 ; -----------------procedures----------------
+89 SET ACKCT=0
SET ACKIEN=""
SET ACKPROCP=""
+90 FOR
SET ACKIEN=$ORDER(@ACKFDA@(509850.61,ACKIEN))
if ACKIEN=""
QUIT
Begin DoDot:1
+91 IF $PIECE(ACKIEN,",",2)'=ACKVIEN
QUIT
+92 ; CPT IEN
SET ACKCPT=@ACKFDA@(509850.61,ACKIEN,.01,"I")
+93 ; Volume
SET ACKVOL=@ACKFDA@(509850.61,ACKIEN,.03,"I")
+94 ; Provider
SET ACKPROCP=@ACKFDA@(509850.61,ACKIEN,.05,"I")
+95 ; Convert from QSR to Vista
IF ACKPROCP'=""
SET ACKPROCP=$$CONVERT1^ACKQUTL4(ACKPROCP)
+96 SET ACKCT=ACKCT+1
SET @ACKAPI@("PROCEDURE",ACKCT,"PROCEDURE")=ACKCPT
+97 SET @ACKAPI@("PROCEDURE",ACKCT,"QTY")=$SELECT(ACKVOL:ACKVOL,1:1)
+98 IF ACKPROCP'=""
SET @ACKAPI@("PROCEDURE",ACKCT,"ENC PROVIDER")=ACKPROCP
+99 ; --------------procedure modifiers-------------
+100 SET ACKIEN2=""
+101 FOR
SET ACKIEN2=$ORDER(@ACKFDA@(509850.64,ACKIEN2))
if ACKIEN2=""
QUIT
Begin DoDot:2
+102 IF $PIECE(ACKIEN2,",",2,3)'=$PIECE(ACKIEN,",",1,2)
QUIT
+103 SET ACKMOD=@ACKFDA@(509850.64,ACKIEN2,.01,"I")
+104 SET ACKMOD=$$GET1^DIQ(509850.5,ACKMOD,.01,"E")
+105 IF $DATA(@ACKAPI@("PROCEDURE",ACKCT,"MODIFIERS"))#10=0
Begin DoDot:3
+106 SET @ACKAPI@("PROCEDURE",ACKCT,"MODIFIERS")=""
End DoDot:3
+107 SET @ACKAPI@("PROCEDURE",ACKCT,"MODIFIERS",ACKMOD)=""
End DoDot:2
End DoDot:1
+108 ;
+109 ; end of build
+110 QUIT
+111 ;
SENDIT ; send the data to PCE
+1 KILL ACKPROB
+2 ;
+3 ; call the PCE package API
+4 SET ACKE=$$DATA2PCE^PXAPI($NAME(^TMP("ACKQPCE1",$JOB,"PXAPI")),ACKPKG,ACKSRC,.ACKPCE,"",0,.ACKE2,"",.ACKPROB)
+5 ;
+6 ; check for returned error messages
+7 KILL ACKRSN
SET ACKRSN=0
+8 IF $DATA(ACKPROB)
DO CONVERT^ACKQPCE2(.ACKPROB,ACKAPI,.ACKRSN)
+9 ;
+10 ; if update failed but no errors were returned then create a message
+11 IF ACKE'=1
IF 'ACKRSN
Begin DoDot:1
+12 SET ACKMSG="Unable to update PCE Visit (error code="_ACKE_")"
+13 DO ADDRSN^ACKQPCE2("PCE VISIT","","",ACKMSG,.ACKRSN)
+14 ; pce ien has been corrupted by the API
IF ACKPCE'>0
Begin DoDot:2
+15 KILL ACKARR
SET ACKARR(509850.6,ACKVIEN_",",125)="@"
+16 DO FILE^DIE("","ACKARR","")
End DoDot:2
End DoDot:1
+17 ;
+18 ; if errors found then file them on the Visit file and create exception
+19 IF ACKE'=1
IF ACKRSN
Begin DoDot:1
+20 DO FILERSN^ACKQPCE(ACKVIEN,.ACKRSN)
+21 KILL ACKARR
+22 ; for new visits!
SET ACKARR(509850.6,ACKVIEN_",",125)=ACKPCE
+23 DO FILE^DIE("","ACKARR","")
End DoDot:1
+24 ;
+25 ; if no errors update the PCE fields
+26 IF ACKE=1
Begin DoDot:1
+27 KILL ACKARR
+28 ; for new visits!
SET ACKARR(509850.6,ACKVIEN_",",125)=ACKPCE
+29 ; date last sent
SET ACKARR(509850.6,ACKVIEN_",",135)=ACKDATE
+30 DO FILE^DIE("","ACKARR","")
+31 ; return flag (1=sent,0=not sent)
SET ACKSENT=1
End DoDot:1
+32 ;
+33 ; end of sendit
+34 QUIT
+35 ;
