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

ACKQUTL3.m

Go to the documentation of this file.
  1. ACKQUTL3 ;HCIOFO/AG - QUASAR Utility Routine ; 12/13/02 3:51pm
  1. ;;3.0;QUASAR;**5**;Feb 11, 2000
  1. ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
  1. ;
  1. PCECHKV(ACKVIEN) ; is PCE Visit still same patient etc.
  1. ; this function will check that the Qsr Visit (ACKVIEN) has the same
  1. ; values for Patient, Clinic, Date and Time as the PCE Visit that it
  1. ; points to.
  1. ; inputs:- ACKVIEN - QUASAR Visit IEN (reqd)
  1. ; outputs:- see function $$PCECHK below!
  1. N ACKTGT,ACKPCE,ACKDT,ACKTM,ACKPAT,ACKCLN
  1. D GETS^DIQ(509850.6,ACKVIEN_",",".01;125;1;2.6;55","I","ACKTGT")
  1. S ACKPCE=$G(ACKTGT(509850.6,ACKVIEN_",",125,"I"))
  1. I 'ACKPCE Q "2^" ; not pointing to a visit
  1. S ACKDT=$G(ACKTGT(509850.6,ACKVIEN_",",.01,"I"))\1
  1. S ACKTM=$G(ACKTGT(509850.6,ACKVIEN_",",55,"I"))
  1. S ACKPAT=$G(ACKTGT(509850.6,ACKVIEN_",",1,"I"))
  1. S ACKCLN=$G(ACKTGT(509850.6,ACKVIEN_",",2.6,"I"))
  1. Q $$PCECHK(ACKPCE,ACKDT,ACKTM,ACKPAT,ACKCLN)
  1. ;
  1. PCECHK(ACKPCE,ACKDT,ACKTM,ACKPAT,ACKCLN) ; is PCE Visit still same patient etc.
  1. ; this function will check that the Qsr Visit (ACKVIEN) has the same
  1. ; values for Patient, Clinic, Date and Time as the PCE Visit that it
  1. ; points to.
  1. ; inputs:- ACKPCE - PCE Visit IEN (reqd)
  1. ; ACKDT - date of visit (reqd) (fileman internal)
  1. ; ACKTM - time of visit (reqd) (qsr time .n[nnnnn])
  1. ; ACKPAT - patient (reqd)
  1. ; ACKCLN - clinic (reqd)
  1. ; outputs:- string
  1. ; value: "0^X^Y^Z" - either the date, patient or clinic differ
  1. ; where X=Clinics are same (1 or 0)
  1. ; Y=Patients are same (1 or 0)
  1. ; Z=Dates are same (1 or 0)
  1. ; eg "0^1^0^0" = patient and dates differ
  1. ; "1^.123" - only time is different (.123=Pce time)
  1. ; "2^" - all fields the same
  1. N PCEDTTM,PCEDT,PCETM,PCEPAT,PCECLN,ACKSTR
  1. K ^TMP("PXKENC",$J)
  1. ;
  1. ; get the visit data from PCE (places it in ^TMP("PXKENC",$J)
  1. D ENCEVENT^PXAPI(ACKPCE)
  1. S PCEDTTM=$P($G(^TMP("PXKENC",$J,ACKPCE,"VST",ACKPCE,0)),U,1)
  1. S PCEDT=PCEDTTM\1,PCETM=PCEDTTM#1
  1. S PCEPAT=$P($G(^TMP("PXKENC",$J,ACKPCE,"VST",ACKPCE,0)),U,5)
  1. S PCECLN=$P($G(^TMP("PXKENC",$J,ACKPCE,"VST",ACKPCE,0)),U,22)
  1. K ^TMP("PXKENC",$J)
  1. ;
  1. ; check date, patient and clinic
  1. I (PCEDT'=ACKDT)!(PCEPAT'=ACKPAT)!(PCECLN'=ACKCLN) D Q ACKSTR
  1. . S ACKSTR="0^"
  1. . S $P(ACKSTR,U,2)=$S(PCECLN=ACKCLN:1,1:0)
  1. . S $P(ACKSTR,U,3)=$S(PCEPAT=ACKPAT:1,1:0)
  1. . S $P(ACKSTR,U,4)=$S(PCEDT=ACKDT:1,1:0)
  1. ;
  1. ; check Appointment time
  1. I +PCETM'=+ACKTM Q "1^"_PCETM
  1. ;
  1. ; must be the same!
  1. Q "2^"
  1. ;
  1. DISPLAY(ACKVIEN,XPOS) ; create summary line for visit selection
  1. N ACKPAT,ACKCLN,ACKTM,ACKTIME,ACKAM,ACKDISP,ACKLEN
  1. S ACKTM=$$GET1^DIQ(509850.6,ACKVIEN_",",55,"I"),ACKTIME=$$FMT^ACKQUTL6(ACKTM,2)
  1. S ACKPAT=$$GET1^DIQ(509850.6,ACKVIEN_",",1,"E")
  1. S ACKCLN=$$GET1^DIQ(509850.6,ACKVIEN_",",2.6,"E")
  1. S ACKP=$S($$GET1^DIQ(509850.6,ACKVIEN_",",125,"I"):".",1:" ")
  1. I XPOS<35 D
  1. . S ACKLEN=80-XPOS-10-2/2
  1. . S ACKPAT=$E(ACKPAT_$J("",ACKLEN),1,ACKLEN\1)
  1. . I $G(%)'="" D
  1. . . I $TR(%,",","")'?.A D
  1. . . . S ACKCLN=$E(ACKCLN_$J("",ACKLEN),1,ACKLEN+.5\1)
  1. . . . S ACKDISP=" "_ACKTIME_ACKP_" "_ACKPAT_" "_ACKCLN
  1. . . I $TR(%,",","")?.A D
  1. . . . S ACKCLN=$E(ACKCLN,1,(40-$L(%)))
  1. . . . S ACKDISP=" "_ACKTIME_ACKP_" "_ACKCLN
  1. . I $G(%)="" D
  1. . . S ACKCLN=$E(ACKCLN_$J("",ACKLEN),1,ACKLEN+.5\1)
  1. . . S ACKDISP=" "_ACKTIME_ACKP_" "_ACKPAT_" "_ACKCLN
  1. I XPOS'<35 D
  1. . S ACKLEN=80-XPOS-10-1
  1. . S ACKPAT=$E(ACKPAT_$J("",ACKLEN),1,ACKLEN)
  1. . S ACKDISP=" "_ACKTIME_ACKP_" "_ACKPAT
  1. Q ACKDISP
  1. ;
  1. PCEERR(ACKVIEN,ACKARR,ACKNUM,ACKWIDE) ; retrieve PCE Errors for a visit and store in ACKARR
  1. ; inputs:- ACKVIEN - visit ien (reqd)
  1. ; ACKARR - array name in which to place errors (indirection
  1. ; used to file data ie @ACKARR@(x) (reqd)
  1. ; ACKNUM - Error number (if only one reqd) (opt)
  1. ; ACKWIDE - max number of characters in each line (opt)
  1. ; outputs:-
  1. ; ACKARR=n - number of lines to display
  1. ; ACKARR(1-n)=text - text of error (wrapped to ACKWIDE characters)
  1. ; if @ACKARR already contains data then this subroutine will append
  1. ; the PCE Errors starting at line @ACKARR+1. It is up to the calling
  1. ; routine to clear the array @ACKARR before calling this function.
  1. N ACKTMP,ACKCT,ACKSUB,TXT,TXT2,I
  1. K ^TMP("ACKQUTL3",$J,"PCEERR")
  1. S ACKTMP=$NA(^TMP("ACKQUTL3",$J,"PCEERR"))
  1. S ACKNUM=+$G(ACKNUM)
  1. S ACKWIDE=$S(+$G(ACKWIDE)<1:80,ACKWIDE<40:40,1:ACKWIDE)
  1. I 'ACKNUM D GETS^DIQ(509850.6,ACKVIEN_",","6.5*","I",ACKTMP,"")
  1. I ACKNUM D GETS^DIQ(509850.65,ACKNUM_","_ACKVIEN_",","*","I",ACKTMP,"")
  1. S ACKCT=+$G(@ACKARR)
  1. S ACKSUB="" F S ACKSUB=$O(@ACKTMP@(509850.65,ACKSUB)) Q:ACKSUB="" D
  1. . I $P(ACKSUB,",",2)'=ACKVIEN Q
  1. . ; field name and external value
  1. . S TXT=@ACKTMP@(509850.65,ACKSUB,.02,"I")_" - "_@ACKTMP@(509850.65,ACKSUB,.04,"I")
  1. . I $L(TXT)'>ACKWIDE D
  1. . . S ACKCT=ACKCT+1,@ACKARR@(ACKCT)=TXT
  1. . I $L(TXT)>ACKWIDE D
  1. . . S TXT=$E(@ACKTMP@(509850.65,ACKSUB,.02,"I"),1,ACKWIDE)
  1. . . S ACKCT=ACKCT+1,@ACKARR@(ACKCT)=TXT
  1. . . S TXT=$E(@ACKTMP@(509850.65,ACKSUB,.04,"I"),1,ACKWIDE)
  1. . . S ACKCT=ACKCT+1,@ACKARR@(ACKCT)=TXT
  1. . ; pce error message
  1. . S TXT=@ACKTMP@(509850.65,ACKSUB,1,"I")
  1. . F Q:TXT="" D
  1. . . S TXT2=$E(TXT,1,ACKWIDE),I=0
  1. . . I $L(TXT2)=ACKWIDE F I=$L(TXT2):-1:0 Q:$E(TXT2,I)?1P
  1. . . I I S TXT2=$E(TXT2,1,I)
  1. . . S TXT=$P(TXT,TXT2,2,255)
  1. . . S ACKCT=ACKCT+1,@ACKARR@(ACKCT)=TXT2
  1. S @ACKARR=ACKCT
  1. K ^TMP("ACKQUTL3",$J,"PCEERR")
  1. Q
  1. ;
  1. PROBLIST(ACKPAT,ACKECHO) ; re-build the problem list for a Patient
  1. ; this function will run down the QUASAR Visits for a patient and
  1. ; create an accurate problem list for the patient on the A&SP
  1. ; PATIENT file. The function will be called from the Patient
  1. ; Inquiry option and the Delete Visit function.
  1. ; inputs:- ACKPAT - patient DFN
  1. ; ACKECHO - whether to display progress
  1. N ACKTMP,ACKVIEN,ACKDT,ACKDT1,ACKIVDT,ACKDIEN,ACKICD,ACKARR
  1. ;
  1. I '+$G(ACKPAT) Q
  1. S ACKECHO=+$G(ACKECHO)
  1. K ^TMP("ACKQUTL3",$J,"PROBLIST")
  1. S ACKTMP=$NA(^TMP("ACKQUTL3",$J,"PROBLIST"))
  1. ;
  1. ; walk down the visits for a patient
  1. S ACKIVDT=0
  1. S ACKVIEN=0 F S ACKVIEN=$O(^ACK(509850.6,"APT",ACKPAT,ACKVIEN)) Q:'ACKVIEN D
  1. . ; get visit date
  1. . S ACKDT=+$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"I")\1
  1. . ; get Diagnosis multiple for this visit
  1. . D GETS^DIQ(509850.6,ACKVIEN_",","3*","I",$NA(@ACKTMP@(1)))
  1. . ; walk down the diagnosis multiple entries
  1. . S ACKDIEN="" F S ACKDIEN=$O(@ACKTMP@(1,509850.63,ACKDIEN)) Q:ACKDIEN="" D
  1. . . I $P(ACKDIEN,",",2)'=ACKVIEN Q
  1. . . S ACKICD=@ACKTMP@(1,509850.63,ACKDIEN,.01,"I")
  1. . . S ACKDT1=$G(@ACKTMP@(2,ACKICD))
  1. . . I ('ACKDT1)!(ACKDT1>ACKDT) S @ACKTMP@(2,ACKICD)=ACKDT
  1. . . I ('ACKIVDT)!(ACKIVDT>ACKDT) S ACKIVDT=ACKDT ; earliest visit date
  1. ;
  1. ; update initial visit date for the patient
  1. K ACKARR
  1. S ACKARR(509850.2,ACKPAT_",",1)=ACKIVDT
  1. D FILE^DIE("","ACKARR","")
  1. ;
  1. ; clear down the diagnosis history for the patient
  1. D GETS^DIQ(509850.2,ACKPAT_",","2*","I",$NA(@ACKTMP@(4)))
  1. S ACKDIEN="" F S ACKDIEN=$O(@ACKTMP@(4,509850.22,ACKDIEN)) Q:ACKDIEN="" D
  1. . I $P(ACKDIEN,",",2)'=ACKPAT Q
  1. . K ACKARR
  1. . S ACKARR(509850.22,ACKDIEN,.01)="@"
  1. . D FILE^DIE("","ACKARR","")
  1. ;
  1. ; if no diagnosis history then display message
  1. I ACKECHO,$O(@ACKTMP@(2,""))="" D G PROBLISX
  1. . W !!,"No Diagnosis was found in the A&SP CLINIC VISIT file for this patient.",!
  1. ;
  1. ; sort new diagnosis list by date
  1. S ACKICD="" F S ACKICD=$O(@ACKTMP@(2,ACKICD)) Q:ACKICD="" D
  1. . S ACKDT=@ACKTMP@(2,ACKICD) S @ACKTMP@(3,ACKDT,ACKICD)=""
  1. ;
  1. ; update diagnosis history
  1. I ACKECHO W !!,"Now updating diagnostic history.",!
  1. S (ACKDT,ACKICD)="" F S ACKDT=$O(@ACKTMP@(3,ACKDT)) Q:ACKDT="" F S ACKICD=$O(@ACKTMP@(3,ACKDT,ACKICD)) Q:ACKICD="" D
  1. . K ACKARR
  1. . S ACKARR(509850.22,"?+1,"_ACKPAT_",",.01)=ACKICD
  1. . S ACKARR(509850.22,"?+1,"_ACKPAT_",",1)=ACKDT
  1. . D UPDATE^DIE("","ACKARR","","")
  1. ;
  1. PROBLISX ; all done
  1. K ^TMP("ACKQUTL3",$J,"PROBLIST")
  1. Q