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

DGPFUT62.m

Go to the documentation of this file.
  1. DGPFUT62 ;SHRPE/SGM - PRF DBRS FILE/GET/SORT ; Mar 1, 2018 17:20
  1. ;;5.3;Registration;**951**;Aug 13, 1993;Build 135
  1. ; Last Edited: SHRPE/SGM - Oct 08, 2018 11:08
  1. ;
  1. ; ^DGPFUT6 is the only component to directly reference this routine
  1. ;
  1. ; ICR# TYPE DESCRIPTION
  1. ;----- ---- -----------------------------------------
  1. ; 2056 Sup $$GET1^DIQ, GETS^DIQ
  1. ; 2051 Sup $$FIND1^DIC
  1. ; 2053 Sup ^DIE: FILE, UPDATE
  1. ;10013 Sup ^DIK
  1. ;10112 Sup $$SITE^VASITE
  1. ;
  1. ;=====================================================================
  1. AASGN(DGIENS,DGPFIN,DGFDA,DGPFUV,DGPFERR) ;
  1. ; Called from STOASGN^DGPFAA
  1. ;BUSINESS RULES:
  1. ; 1. Create FDA(), do not change any data in existing files
  1. ; Calling program will call FILE^DIE or UPDATE^DIE
  1. ; 2. Calling program may add DGPFA("ACTION") if it has an associated
  1. ; History record.
  1. ; 3. If ACTION is 3 (Inactive) no DBRS data edited
  1. ; 4. If ACTION is 5 (EIE), delete all existing DBRS data, add no new
  1. ; DBRS data
  1. ; 5. If ACTION is 7 (Refresh), delete all existing DBRS before adding
  1. ; 6. Updates called from processing HL7 message
  1. ; May set DGPFA("DBRS ACTION") = U:add/update D:delete
  1. ; Applies to that one DBRS record only
  1. ; 7. DBRS DATE and SITE fields may not be overwritten except for
  1. ; Refresh
  1. ; 8. Only REFRESH action is authorized to overwrite an existing field
  1. ; values for DATE and CREATE SITE
  1. ;
  1. ;INPUT PARAMETERS:
  1. ; DGIENS - 26.13 iens, may be +N, or N,
  1. ; .DGPFIN - DGPFA() passed by reference - see DGPFAA for details
  1. ; .DGFDA - FDA() array to be populated, may have existing values
  1. ; DGPFUV - optional - default to "", consists of single character
  1. ; ="D" delete all existing DBRS records before adding others
  1. ; ="d" delete all existing DBRS record, quit, do not
  1. ; continue processing in this module
  1. ; ="" only act upon DBRS# indicated in DGPFA()
  1. ;
  1. ;RETURN PARAMETERS:
  1. ; .DGFDA - FDA() array to be populated if appropriate
  1. ; .DGPFERR - error message array
  1. ; $D(DGPFERR) - fail, calling program does not continue
  1. ; '$D(DGPFERR) - calling program continues
  1. ;
  1. N I,J,X,ACT,FAC,DBRS,DGDBRS,DIEN,INC,NOW,SITE
  1. ; initialize local variables
  1. I '$L($G(DGIENS)) Q
  1. S:$E(DGIENS,$L(DGIENS))'="," DGIENS=DGIENS_","
  1. S NOW=+$E($$NOW^XLFDT,1,12)
  1. S FAC=+$$SITE^VASITE
  1. S ACT=+$G(DGPFIN("ACTION"))
  1. S DGPFUV=$$UV^DGPFAA Q:DGPFUV=-1
  1. I ACT=5,DGPFUV'="d" S DGPFUV="d"
  1. I ACT=3 Q ; no editing of DBRS data for inactivate
  1. ; do not set up DGFDA()
  1. ;
  1. ; see GETDBRS for array description
  1. ; DBRS(dbrs#,1) = 26.131_iens
  1. ; DBRS(dbrs#,1,sub) = pre_edit_image
  1. ; DBRS(dbrs#,2) = < does not exist >
  1. ; DBRS(dbrs#,2,sub) = post_edit_image
  1. ;
  1. ; get current DBRS records on file (PRE-image)
  1. I DGIENS'["+" D
  1. . N X,ARR
  1. . D GETDBRS(.ARR,DGIENS)
  1. . I $G(ARR(0))>0 S X=0 F S X=$O(ARR(X)) Q:X="" D
  1. . . S DBRS(X,1)=ARR(X) ; 26.131 iens value
  1. . . S DBRS(X,1,"DBRS#")=X
  1. . . S DBRS(X,1,"OTHER")=$P($G(ARR(X,"OTHER")),U)
  1. . . S DBRS(X,1,"DATE")=$P($G(ARR(X,"DATE")),U)
  1. . . S DBRS(X,1,"SITE")=$P($G(ARR(X,"SITE")),U)
  1. . . Q
  1. . Q
  1. ;
  1. ; moved INPUT data to DBRS(dbrs#,2) [POST-image]
  1. S I=0 F J=0:0 S I=$O(DGPFIN("DBRS#",I)) Q:'I D
  1. . N X,Y
  1. . S DBRS=$P(DGPFIN("DBRS#",I),U)
  1. . S DBRS(DBRS,2,"DBRS#")=DBRS
  1. . S Y=$P(DGPFIN("DBRS OTHER",I),U) S:Y="<no value>" Y=""
  1. . S DBRS(DBRS,2,"OTHER")=Y
  1. . S Y=$P(DGPFIN("DBRS DATE",I),U)
  1. . S DBRS(DBRS,2,"DATE")=Y
  1. . S Y=$P(DGPFIN("DBRS SITE",I),U)
  1. . S DBRS(DBRS,2,"SITE")=Y
  1. . ; DBRS ACTION only comes from HL7 message processing
  1. . ; Set ACT to -1 if not coming from HL7 processing
  1. . S X=$G(DGPFIN("DBRS ACTION",I),-1)
  1. . S DBRS(DBRS,2,"ACT")=$P(X,U)
  1. . Q
  1. ;
  1. ; set up FDA()
  1. ;
  1. ; if DGPFUV="d" or ="D" then set all existing DBRS records to be
  1. ; deleted. Edits may override delete
  1. ; if DGPFUV="" then called from PRF HL processor, only act upon
  1. ; specific DBRS# listed in DGPFA()
  1. ;
  1. I DGPFUV="D"!(DGPFUV="d") D
  1. . N X,Y,IENS,NM
  1. . S NM="" F S NM=$O(DBRS(NM)) Q:NM="" I $D(DBRS(NM,1)) D
  1. . . S IENS=DBRS(NM,1),DGFDA(26.131,IENS,.01)="@"
  1. . . Q
  1. . Q
  1. I DGPFUV="d" Q
  1. ;
  1. S INC=10 ; incrementor used for add new DBRS record
  1. S DBRS=0 F J=0:0 S DBRS=$O(DBRS(DBRS)) Q:DBRS="" D
  1. . N ACT,HLACT,DIEN,IENS
  1. . S IENS=$G(DBRS(DBRS,1))
  1. . S HLACT=$G(DBRS(DBRS,2,"ACT"))
  1. . S ACT=+$G(DGPFIN("ACTION"))
  1. . ;
  1. . ; PRE exists, POST does not; record deleted if DGPFUV="D"
  1. . I $D(DBRS(DBRS,1)),'$D(DBRS(DBRS,2)) Q
  1. . ;
  1. . ; POST exists, PRE does not, adding a new record
  1. . ; Post DBRS action may be Delete
  1. . I $D(DBRS(DBRS,2)),'$D(DBRS(DBRS,1)) D Q
  1. . . I HLACT="D" Q
  1. . . S INC=INC+1,DIEN="+"_INC_","_DGIENS
  1. . . S DGFDA(26.131,DIEN,.01)=DBRS
  1. . . S X=DBRS(DBRS,2,"OTHER") S:$L(X) DGFDA(26.131,DIEN,.02)=X
  1. . . S X=DBRS(DBRS,2,"DATE") S:+X DGFDA(26.131,DIEN,.03)=X
  1. . . S X=DBRS(DBRS,2,"SITE") S:+X DGFDA(26.131,DIEN,.04)=X
  1. . . Q
  1. . ;
  1. . ; Both PRE and POST exists, update existing record
  1. . ; conditional update of fields .03,.04
  1. . I HLACT="D" S DGFDA(26.131,IENS,.01)="@" Q
  1. . K DGFDA(26.131,IENS,.01)
  1. . S X=$G(DBRS(DBRS,1,"OTHER")),Y=$G(DBRS(DBRS,2,"OTHER")) D
  1. . . I X'=Y S DGFDA(26.131,IENS,.02)=Y
  1. . . Q
  1. . S X=$G(DBRS(DBRS,1,"DATE")),Y=$G(DBRS(DBRS,2,"DATE")) D
  1. . . I $S((ACT=7)!(ACT=8):1,+X:0,1:+Y) S DGFDA(26.131,IENS,.03)=Y
  1. . . Q
  1. . S X=$G(DBRS(DBRS,1,"SITE")),Y=$G(DBRS(DBRS,2,"SITE")) D
  1. . . I $S((ACT=7)!(ACT=8):1,+X:0,1:+Y) S DGFDA(26.131,IENS,.04)=Y
  1. . . Q
  1. . Q
  1. Q
  1. ;
  1. ;=====================================================================
  1. DEL(DGXIEN,DGFILE) ;
  1. ; delete all DBRS records for a flag assignment or history record
  1. ; QA on input values done in DGPFUT6
  1. Q:'$G(DGXIEN) Q:'$G(DGFILE)
  1. S DGXIEN=+DGXIEN
  1. Q:'$O(^DGPF(DGFILE,DGXIEN,2,0))
  1. Q:"^26.13^26.14^"'[(U_DGFILE_U)
  1. N X,Y,DA,DGDBRSE,DIK
  1. S DGDBRSE=1 ; not need but cya, DEL node on ^DD(26.131,.01)
  1. S DIK="^DGPF("_DGFILE_","_DGXIEN_",2," S DA(1)=DGIEN
  1. S DA=0 F S DA=$O(^DGPF(DGFILE,DGXIEN,2,DA)) Q:'DA D ^DIK
  1. Q
  1. ;
  1. ;=====================================================================
  1. GETDBRS(DGRET,DGAIEN) ;
  1. ;Return all DBRS data associated with a CAT I BEHAVIORAL assignment
  1. ;INPUT PARAMETER: DGPFIEN - req - file_26.13_ien
  1. ;RETURN VALUES:
  1. ; .DGRET(0) = total number of DBRS records [0,1,2,...]
  1. ; .DGRET(dbrs#) = <26.131_ien>,<26.13_ien>, [iens]
  1. ; (dbrs#,"DBRS#") = internal^external [#.01]
  1. ; (dbrs#,"OTHER") = internal^external [#.02]
  1. ; (dbrs#,"DATE") = internal^external [#.03]
  1. ; (dbrs#,"SITE") = internal^external [#.04]
  1. ;
  1. N X,Y,DGARR,DGIEN,DGERR,DIERR,IENS
  1. S DGRET(0)=0
  1. S DGAIEN=$G(DGAIEN) Q:$E(DGAIEN)="+" Q:'DGAIEN
  1. ;
  1. S DGIEN=(+DGAIEN)_","
  1. D GETS^DIQ(26.13,DGIEN,".02;2*","IE","DGARR","DGERR")
  1. Q:$D(DIERR)
  1. Q:DGARR(26.13,DGIEN,.02,"I")'[26.15
  1. Q:DGARR(26.13,DGIEN,.02,"E")'="BEHAVIORAL"
  1. S IENS=0 F S IENS=$O(DGARR(26.131,IENS)) Q:'IENS D
  1. . N DBRS,TMP M TMP=DGARR(26.131,IENS)
  1. . S DBRS=TMP(.01,"E")
  1. . S DGRET(0)=1+DGRET(0)
  1. . S DGRET(DBRS)=IENS
  1. . S DGRET(DBRS,"DBRS#")=TMP(.01,"I")_U_TMP(.01,"E")
  1. . S DGRET(DBRS,"OTHER")=TMP(.02,"I")_U_TMP(.02,"E")
  1. . S DGRET(DBRS,"DATE")=TMP(.03,"I")_U_TMP(.03,"E")
  1. . S DGRET(DBRS,"SITE")=TMP(.04,"I")_U_TMP(.04,"E")
  1. . Q
  1. Q
  1. ;
  1. ;=====================================================================
  1. GETDBRSH(DGRET,DGHIEN) ;
  1. ; Get DBRS data for a History record
  1. ;INPUT PARAMETERS: DGPFIEN - req - ien to file 26.14
  1. ;RETURN VALUES:
  1. ; .DGRET(0) = total number of DBRS records
  1. ; .DGRET(dbrs#) = <26.142_ien>,<26.14_ien>, [iens]
  1. ; (dbrs#,"DBRS#") = internal^external [#.01]
  1. ; (dbrs#,"OTHER") = internal^external [#.02]
  1. ; (dbrs#,"DATE") = internal^external [#.03]
  1. ; (dbrs#,"STAT") = internal^external [#.04]
  1. ; (dbrs#,"SITE") = internal^external [#.05]
  1. ;
  1. S DGRET(0)=0
  1. S DGHIEN=$G(DGHIEN)
  1. I DGHIEN,$D(^DGPF(26.14,DGHIEN,2)) D
  1. . N DGARR,DGERR,DIERR,IEN,IENS
  1. . S IENS=(+DGHIEN)_","
  1. . D GETS^DIQ(26.14,IENS,"2*","IE","DGARR","DGERR")
  1. . Q:$D(DIERR)
  1. . S IEN=0 F S IEN=$O(DGARR(26.142,IEN)) Q:'IEN D
  1. . . N DBRS,TMP
  1. . . M TMP=DGARR(26.142,IEN)
  1. . . S DBRS=TMP(.01,"E")
  1. . . S DGRET(0)=1+DGRET(0)
  1. . . S DGRET(DBRS)=IEN
  1. . . S DGRET(DBRS,"DBRS#")=TMP(.01,"I")_U_TMP(.01,"E")
  1. . . S DGRET(DBRS,"OTHER")=TMP(.02,"I")_U_TMP(.02,"E")
  1. . . S DGRET(DBRS,"DATE")=TMP(.03,"I")_U_$P(TMP(.03,"E"),":",1,2)
  1. . . S DGRET(DBRS,"STAT")=TMP(.04,"I")_U_TMP(.04,"E")
  1. . . S DGRET(DBRS,"SITE")=TMP(.05,"I")_U_TMP(.05,"E")
  1. . . Q
  1. . Q
  1. Q
  1. ;
  1. ;=====================================================================
  1. STOHIST(DGIENS,DGFLD,DGFDA,DGPFERR) ;
  1. ; Set up FDA() for use in UPDATE^DIE
  1. ; For more information on input params, see STOHIST^DGPFAAH
  1. ;INPUT PARAMETERS:
  1. ; DGIENS - req - fda() iens to file 26.14, may be "+1,"
  1. ; .DGFLD - req - subset of DGPFAH()
  1. ;RETURN PARAMETERS:
  1. ; .DGFDA - FDA array of UPDATE^DIE
  1. ; DGFDA() may have existing nodes unrelated to DBRS
  1. ; .DGPFERR - error array to return to calling program
  1. ;
  1. N I,J,IEN,INC
  1. S DGIENS=$G(DGIENS) I DGIENS="" Q
  1. I $E(DGIENS)'="+",'$D(^DGPF(26.14,+DGIENS,0)) Q
  1. Q:'$D(DGFLD("DBRS"))
  1. ;
  1. S INC=50,I=0 F J=0:0 S I=$O(DGFLD("DBRS",I)) Q:'I D
  1. . N J,IENS,INP
  1. . ; expects DGFLD("DBRS",I) to consist of 5 single valued pieces
  1. . F J=1:1:5 S INP(J)=$P(DGFLD("DBRS",I),U,J)
  1. . S INC=INC+1,IENS="+"_INC_","_DGIENS
  1. . S DGFDA(26.142,IENS,.01)=INP(1) ; DBRS#
  1. . I $L(INP(2)) S DGFDA(26.142,IENS,.02)=INP(2) ; OTHER
  1. . I +INP(3) S DGFDA(26.142,IENS,.03)=INP(3) ; DATE
  1. . I INP(4)?1U S DGFDA(26.142,IENS,.04)=INP(4) ; STAT
  1. . I +INP(5) S DGFDA(26.142,IENS,.05)=INP(5) ; SITE
  1. . Q
  1. Q