DGPFAAH2 ;SHRPE/SGM - PRF ASSIGNMENT HISTORY API'S ; 5/1/2018 17:00
;;5.3;Registration;**960**;Aug 13, 1993;Build 22
; Last Edited: SHRPE/sgm - Jul 5, 2018 11:07
;
; This routine was introduced in patch 960 to provide additional
; History related APIs. Patch DG*5.3*951 will be released subsequent
; to this 960 patch. The 951 will provide a common API entry point
; in the DGPFAAH routine.
;
; This routine will ONLY be invoked via the DGPFAAH routine!
;
; ICR# TYPE DESCRIPTION
;----- ---- ------------------------------------
; 2052 Sup $$GET1^DID
;10103 Sup $$FMTE^XLFDT
;
QUIT
;------------------------ API Entry Points -------------------------
;
ACTFILT(DGHIST,DGIEN,DGACT,DGFLDS,DGBY) ;
; For an assignment, return a list of History records with a specific
; action type
D ACT Q:$Q +$G(@DGHIST) Q
;
INACT(DGIEN) ;
; For an assignment, return the date of the last inactivation action
Q $$LASTIN
;
LAST(DGIEN) ;
; For an assignment, return the date of the last activation action
Q $$LASTACT
;
;----------------- Private Main Processing Modules -----------------
ACT ;
; Find all History records associated with an assignment and return
; only those History records of a certain ACTION types
; This may be called as an Extrinsic Function or as a DO w/params
; Use APIs in DGPFAAH if you wish all history records and data
; Use APIs in DGPFAA if you wish all assignment record data
;
; INPUT PARAMETERS:
; DGIEN - required - Pointer to PRF ASSIGNMENT (#26.13) file
; DGACT - required - ';'-delimited string of ACTION set of codes
; see ^DD(26.14,.03)
; DGFLDS - optional - return field values from 26.14
; ';'-delimited string can be field numbers or text
; subscripts as returned in DGPFAAH and DGPFAA routines
; Default - ACTION ; DATE/TIME
; DGBY - optional - return sorting order, default to I
; A:sort by action (action_code,ien)=ien^action_code^date/time
; D:sort by date (date/time,ien) =ien^action_code^date/time
; I:sort by ien (1,ien) =ien^action_code^date/time
;
; RETURN PARAMETER:
; DGHIST - named reference to return values
; default to .DGHIST
; @DGHIST = total number of records returned or -1
; @DGHIST@(sub1,sub2,sub3) = internal_FM_value ^ external_FM_value
; where sub1 = action_code_name if BY="A"
; sub1 = assignment date.time if BY="D"
; sub1 = 1 if BY="I"
; sub2 = history record ien
; sub3 = text name for history field (see F14 below)
;
; EXTRINSIC FUNCTION:
; Return the total number of history records found
;
N CNT,DGHIEN,INPUT,TMP
S CNT=0
S RET=$G(DGHIST) S:RET="" RET="DGHIST"
S TMP=$NA(^TMP("DGPFAAH2",$J)) K @TMP
; validate input parameters
; INPUT("FLDS",field#) = text_subscript
; INPUT("FLDS",text_subscript) = field#
; INPUT("ACT",set_of_code#) = set of code name
; INPUT("BY") = A / D / I
I '$$INPUT S CNT=-1 G ACTOUT
; get all History records for an assignment
; if entered in error action encountered, remove all history records
; prior to the EIE record
I $$GETALLDT^DGPFAAH(DGIEN,.DGHIEN) D
. ; dghien(assignment_dt)=hien
. N DATE
. ; sort history data by assignment date.time
. S DATE=-1 F S DATE=$O(DGHIEN(DATE)) Q:'DATE D
. . N DGPFAH,HIEN
. . S HIEN=DGHIEN(DATE)
. . ; Q:'$$GETHIST^DGPFAAH(HIEN,.DGPFAH,1) ;after patch 960 released
. . Q:'$$GETHIST^DGPFAAH(HIEN,.DGPFAH)
. . M @TMP@(DATE,HIEN)=DGPFAH
. . Q
. ; D EIE
. Q
;
I $D(@TMP) D
. N I,X,Y,ACT,DATE,HIEN,SUB
. ; filter records and set up return array
. S DATE=-1 F S DATE=$O(@TMP@(DATE)) Q:'DATE D
. . S HIEN=0 F S HIEN=$O(@TMP@(DATE,HIEN)) Q:'HIEN D
. . . ; is history record one of the actions
. . . S ACT=+$G(@TMP@(DATE,HIEN,"ACTION"))
. . . I '$D(INPUT("ACT",ACT)) K @TMP@(DATE,HIEN) Q
. . . S CNT=CNT+1
. . . S X=INPUT("BY")
. . . S SUB=$S(X="A":INPUT("ACT",ACT),X="D":DATE,1:1)
. . . ; set up return with field text names, not field#
. . . S X=100 F S X=$O(INPUT("FLDS",X)) Q:X="" D
. . . . S @RET@(SUB,HIEN,X)=@TMP@(DATE,HIEN,X)
. . . . Q
. . . Q
. . Q
. Q
;
ACTOUT ;
S @RET=CNT
K @TMP
Q:$Q CNT
Q
;
LASTACT ;
; For a PRF assignment return that date of the last activation action
;
; INPUT PARAMETER:
; DGIEN - required - Pointer to PRF ASSIGNMENT (#26.13) file
; EXTRINSIC FUNCTION: return null or p1^p2^p3
; p1 = internal FM date.time p2 = mm/dd/yy p3 = mm/dd/yyyy
;
N DATE,DGACT,DGBY,DGFLDS,DGHIST
S DGACT="1;3;4;5"
S DGFLDS=".01;.02;.03"
S DGBY="D"
S DATE="" I $$ACTFILT(.DGHIST,DGIEN,DGACT,DGFLDS,DGBY)>0 D
. ; dghist(assign_d/t,hist_ien,field_text) = int_val^ext_val
. N X,Y,ACT,IEN
. S Y="A" F S Y=$O(DGHIST(Y),-1) Q:Y<1 D Q:DATE
. . S IEN="A" F S IEN=$O(DGHIST(Y,IEN),-1) Q:'IEN D Q:DATE
. . . S ACT=+$G(DGHIST(Y,IEN,"ACTION"))
. . . I ACT=1!(ACT=4) S DATE=Y
. . . Q
. . Q
. Q
S:DATE $P(DATE,U,2)=$$FMTE^XLFDT(DATE\1,"2Z")_U_$$FMTE^XLFDT(DATE\1,"5Z")
Q DATE
;
LASTIN ;
;For a PRF assignment return that date of the last inactivation action
;
; INPUT PARAMETER:
; DGIEN - required - Pointer to PRF ASSIGNMENT (#26.13) file
; EXTRINSIC FUNCTION: return null or p1^p2^p3
; p1 = internal FM date.time p2 = mm/dd/yy p3 = mm/dd/yyyy
;
N DATE,DGACT,DGBY,DGFLDS,DGHIST
S DGACT="3;5"
S DGFLDS=".01;.02;.03"
S DGBY="D"
S DATE=""
I $$ACTFILT(.DGHIST,DGIEN,DGACT,DGFLDS,DGBY)>0 D
. ; dghist(assign_d/t,hist_ien,field_text) = int_val^ext_val
. N X,Y,ACT,IEN
. S Y="A" F S Y=$O(DGHIST(Y),-1) Q:Y<1 D Q:DATE
. . S IEN="A" F S IEN=$O(DGHIST(Y,IEN),-1) Q:'IEN D Q:DATE
. . . S ACT=+$G(DGHIST(Y,IEN,"ACTION"))
. . . I ACT=3!(ACT=5) S DATE=Y
. . . Q
. . Q
. Q
S:DATE $P(DATE,U,2)=$$FMTE^XLFDT(DATE\1,"2Z")_U_$$FMTE^XLFDT(DATE\1,"5Z")
Q DATE
;
;----------------------- PRIVATE SUBROUTINES -----------------------
;
F14 ;
;;.01^ASSIGN
;;.02^ASSIGNDT
;;.03^ACTION
;;.04^ENTERBY
;;.05^APPRVBY
;;.06^TIULINK
;;.09^ORIGFAC
;;
N I,X,Y
F I=1:1 S X=$P($T(F14+I),";",3) Q:X="" D
. S Y=$P(X,U,2),DATA(+X)=Y,DATA(Y)=+X
. Q
Q
;
INPUT() ; validate input parameters
N I,X,Y,DATA,DGERR,DIERR,TMP,TX
S DGIEN=+$G(DGIEN) I '$D(^DGPF(26.13,DGIEN,0)) Q 0
D F14 ; sets up DATA()
; validate DGFLDS
; INPUT("FLDS",file#,field#)=textname
; INPUT("FLDS",file#,textname)=field#
S X=$G(DGFLDS) I $L(X) D
. F I=1:1:$L(X,";") S Y=$P(X,";",I) D
. . Q:Y="" Q:'$D(DATA(Y))
. . S TX=$S(Y=+Y:DATA(Y),1:Y)
. . I Y'=+Y S Y=DATA(TX)
. . S INPUT("FLDS",Y)=TX,INPUT("FLDS",TX)=Y
. . Q
. Q
; add in default fields if necessary
S X="ASSIGNDT" I '$D(INPUT("FLDS",X)) D
. S INPUT("FLDS",.02)=X,INPUT("FLDS",X)=.02
. Q
S X="ACTION" I '$D(INPUT("FLDS",X)) D
. S INPUT("FLDS",.03)=X,INPUT("FLDS",X)=.03
. Q
; validate DGACT
S DGACT=$G(DGACT) I DGACT="" Q 0
S X=$$GET1^DID(26.14,.03,,"SET OF CODES",,"DGERR")
F I=1:1:$L(X,";") S Y=$P(X,";",I) Q:Y="" S TMP(+Y)=$P(Y,":",2)
F I=1:1:$L(DGACT,";") S X=$P(DGACT,";",I) D
. I +X,$D(TMP(X)) S INPUT("ACT",X)=TMP(X)
. Q
I '$D(INPUT("ACT")) Q 0
; validate DGBY
S X=$G(DGBY),X=$S(X="":"I","ADI"[$E(X):$E(X),1:"I")
S INPUT("BY")=X
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFAAH2 7519 printed Dec 13, 2024@02:47:21 Page 2
DGPFAAH2 ;SHRPE/SGM - PRF ASSIGNMENT HISTORY API'S ; 5/1/2018 17:00
+1 ;;5.3;Registration;**960**;Aug 13, 1993;Build 22
+2 ; Last Edited: SHRPE/sgm - Jul 5, 2018 11:07
+3 ;
+4 ; This routine was introduced in patch 960 to provide additional
+5 ; History related APIs. Patch DG*5.3*951 will be released subsequent
+6 ; to this 960 patch. The 951 will provide a common API entry point
+7 ; in the DGPFAAH routine.
+8 ;
+9 ; This routine will ONLY be invoked via the DGPFAAH routine!
+10 ;
+11 ; ICR# TYPE DESCRIPTION
+12 ;----- ---- ------------------------------------
+13 ; 2052 Sup $$GET1^DID
+14 ;10103 Sup $$FMTE^XLFDT
+15 ;
+16 QUIT
+17 ;------------------------ API Entry Points -------------------------
+18 ;
ACTFILT(DGHIST,DGIEN,DGACT,DGFLDS,DGBY) ;
+1 ; For an assignment, return a list of History records with a specific
+2 ; action type
+3 DO ACT
if $QUIT
QUIT +$GET(@DGHIST)
QUIT
+4 ;
INACT(DGIEN) ;
+1 ; For an assignment, return the date of the last inactivation action
+2 QUIT $$LASTIN
+3 ;
LAST(DGIEN) ;
+1 ; For an assignment, return the date of the last activation action
+2 QUIT $$LASTACT
+3 ;
+4 ;----------------- Private Main Processing Modules -----------------
ACT ;
+1 ; Find all History records associated with an assignment and return
+2 ; only those History records of a certain ACTION types
+3 ; This may be called as an Extrinsic Function or as a DO w/params
+4 ; Use APIs in DGPFAAH if you wish all history records and data
+5 ; Use APIs in DGPFAA if you wish all assignment record data
+6 ;
+7 ; INPUT PARAMETERS:
+8 ; DGIEN - required - Pointer to PRF ASSIGNMENT (#26.13) file
+9 ; DGACT - required - ';'-delimited string of ACTION set of codes
+10 ; see ^DD(26.14,.03)
+11 ; DGFLDS - optional - return field values from 26.14
+12 ; ';'-delimited string can be field numbers or text
+13 ; subscripts as returned in DGPFAAH and DGPFAA routines
+14 ; Default - ACTION ; DATE/TIME
+15 ; DGBY - optional - return sorting order, default to I
+16 ; A:sort by action (action_code,ien)=ien^action_code^date/time
+17 ; D:sort by date (date/time,ien) =ien^action_code^date/time
+18 ; I:sort by ien (1,ien) =ien^action_code^date/time
+19 ;
+20 ; RETURN PARAMETER:
+21 ; DGHIST - named reference to return values
+22 ; default to .DGHIST
+23 ; @DGHIST = total number of records returned or -1
+24 ; @DGHIST@(sub1,sub2,sub3) = internal_FM_value ^ external_FM_value
+25 ; where sub1 = action_code_name if BY="A"
+26 ; sub1 = assignment date.time if BY="D"
+27 ; sub1 = 1 if BY="I"
+28 ; sub2 = history record ien
+29 ; sub3 = text name for history field (see F14 below)
+30 ;
+31 ; EXTRINSIC FUNCTION:
+32 ; Return the total number of history records found
+33 ;
+34 NEW CNT,DGHIEN,INPUT,TMP
+35 SET CNT=0
+36 SET RET=$GET(DGHIST)
if RET=""
SET RET="DGHIST"
+37 SET TMP=$NAME(^TMP("DGPFAAH2",$JOB))
KILL @TMP
+38 ; validate input parameters
+39 ; INPUT("FLDS",field#) = text_subscript
+40 ; INPUT("FLDS",text_subscript) = field#
+41 ; INPUT("ACT",set_of_code#) = set of code name
+42 ; INPUT("BY") = A / D / I
+43 IF '$$INPUT
SET CNT=-1
GOTO ACTOUT
+44 ; get all History records for an assignment
+45 ; if entered in error action encountered, remove all history records
+46 ; prior to the EIE record
+47 IF $$GETALLDT^DGPFAAH(DGIEN,.DGHIEN)
Begin DoDot:1
+48 ; dghien(assignment_dt)=hien
+49 NEW DATE
+50 ; sort history data by assignment date.time
+51 SET DATE=-1
FOR
SET DATE=$ORDER(DGHIEN(DATE))
if 'DATE
QUIT
Begin DoDot:2
+52 NEW DGPFAH,HIEN
+53 SET HIEN=DGHIEN(DATE)
+54 ; Q:'$$GETHIST^DGPFAAH(HIEN,.DGPFAH,1) ;after patch 960 released
+55 if '$$GETHIST^DGPFAAH(HIEN,.DGPFAH)
QUIT
+56 MERGE @TMP@(DATE,HIEN)=DGPFAH
+57 QUIT
End DoDot:2
+58 ; D EIE
+59 QUIT
End DoDot:1
+60 ;
+61 IF $DATA(@TMP)
Begin DoDot:1
+62 NEW I,X,Y,ACT,DATE,HIEN,SUB
+63 ; filter records and set up return array
+64 SET DATE=-1
FOR
SET DATE=$ORDER(@TMP@(DATE))
if 'DATE
QUIT
Begin DoDot:2
+65 SET HIEN=0
FOR
SET HIEN=$ORDER(@TMP@(DATE,HIEN))
if 'HIEN
QUIT
Begin DoDot:3
+66 ; is history record one of the actions
+67 SET ACT=+$GET(@TMP@(DATE,HIEN,"ACTION"))
+68 IF '$DATA(INPUT("ACT",ACT))
KILL @TMP@(DATE,HIEN)
QUIT
+69 SET CNT=CNT+1
+70 SET X=INPUT("BY")
+71 SET SUB=$SELECT(X="A":INPUT("ACT",ACT),X="D":DATE,1:1)
+72 ; set up return with field text names, not field#
+73 SET X=100
FOR
SET X=$ORDER(INPUT("FLDS",X))
if X=""
QUIT
Begin DoDot:4
+74 SET @RET@(SUB,HIEN,X)=@TMP@(DATE,HIEN,X)
+75 QUIT
End DoDot:4
+76 QUIT
End DoDot:3
+77 QUIT
End DoDot:2
+78 QUIT
End DoDot:1
+79 ;
ACTOUT ;
+1 SET @RET=CNT
+2 KILL @TMP
+3 if $QUIT
QUIT CNT
+4 QUIT
+5 ;
LASTACT ;
+1 ; For a PRF assignment return that date of the last activation action
+2 ;
+3 ; INPUT PARAMETER:
+4 ; DGIEN - required - Pointer to PRF ASSIGNMENT (#26.13) file
+5 ; EXTRINSIC FUNCTION: return null or p1^p2^p3
+6 ; p1 = internal FM date.time p2 = mm/dd/yy p3 = mm/dd/yyyy
+7 ;
+8 NEW DATE,DGACT,DGBY,DGFLDS,DGHIST
+9 SET DGACT="1;3;4;5"
+10 SET DGFLDS=".01;.02;.03"
+11 SET DGBY="D"
+12 SET DATE=""
IF $$ACTFILT(.DGHIST,DGIEN,DGACT,DGFLDS,DGBY)>0
Begin DoDot:1
+13 ; dghist(assign_d/t,hist_ien,field_text) = int_val^ext_val
+14 NEW X,Y,ACT,IEN
+15 SET Y="A"
FOR
SET Y=$ORDER(DGHIST(Y),-1)
if Y<1
QUIT
Begin DoDot:2
+16 SET IEN="A"
FOR
SET IEN=$ORDER(DGHIST(Y,IEN),-1)
if 'IEN
QUIT
Begin DoDot:3
+17 SET ACT=+$GET(DGHIST(Y,IEN,"ACTION"))
+18 IF ACT=1!(ACT=4)
SET DATE=Y
+19 QUIT
End DoDot:3
if DATE
QUIT
+20 QUIT
End DoDot:2
if DATE
QUIT
+21 QUIT
End DoDot:1
+22 if DATE
SET $PIECE(DATE,U,2)=$$FMTE^XLFDT(DATE\1,"2Z")_U_$$FMTE^XLFDT(DATE\1,"5Z")
+23 QUIT DATE
+24 ;
LASTIN ;
+1 ;For a PRF assignment return that date of the last inactivation action
+2 ;
+3 ; INPUT PARAMETER:
+4 ; DGIEN - required - Pointer to PRF ASSIGNMENT (#26.13) file
+5 ; EXTRINSIC FUNCTION: return null or p1^p2^p3
+6 ; p1 = internal FM date.time p2 = mm/dd/yy p3 = mm/dd/yyyy
+7 ;
+8 NEW DATE,DGACT,DGBY,DGFLDS,DGHIST
+9 SET DGACT="3;5"
+10 SET DGFLDS=".01;.02;.03"
+11 SET DGBY="D"
+12 SET DATE=""
+13 IF $$ACTFILT(.DGHIST,DGIEN,DGACT,DGFLDS,DGBY)>0
Begin DoDot:1
+14 ; dghist(assign_d/t,hist_ien,field_text) = int_val^ext_val
+15 NEW X,Y,ACT,IEN
+16 SET Y="A"
FOR
SET Y=$ORDER(DGHIST(Y),-1)
if Y<1
QUIT
Begin DoDot:2
+17 SET IEN="A"
FOR
SET IEN=$ORDER(DGHIST(Y,IEN),-1)
if 'IEN
QUIT
Begin DoDot:3
+18 SET ACT=+$GET(DGHIST(Y,IEN,"ACTION"))
+19 IF ACT=3!(ACT=5)
SET DATE=Y
+20 QUIT
End DoDot:3
if DATE
QUIT
+21 QUIT
End DoDot:2
if DATE
QUIT
+22 QUIT
End DoDot:1
+23 if DATE
SET $PIECE(DATE,U,2)=$$FMTE^XLFDT(DATE\1,"2Z")_U_$$FMTE^XLFDT(DATE\1,"5Z")
+24 QUIT DATE
+25 ;
+26 ;----------------------- PRIVATE SUBROUTINES -----------------------
+27 ;
F14 ;
+1 ;;.01^ASSIGN
+2 ;;.02^ASSIGNDT
+3 ;;.03^ACTION
+4 ;;.04^ENTERBY
+5 ;;.05^APPRVBY
+6 ;;.06^TIULINK
+7 ;;.09^ORIGFAC
+8 ;;
+9 NEW I,X,Y
+10 FOR I=1:1
SET X=$PIECE($TEXT(F14+I),";",3)
if X=""
QUIT
Begin DoDot:1
+11 SET Y=$PIECE(X,U,2)
SET DATA(+X)=Y
SET DATA(Y)=+X
+12 QUIT
End DoDot:1
+13 QUIT
+14 ;
INPUT() ; validate input parameters
+1 NEW I,X,Y,DATA,DGERR,DIERR,TMP,TX
+2 SET DGIEN=+$GET(DGIEN)
IF '$DATA(^DGPF(26.13,DGIEN,0))
QUIT 0
+3 ; sets up DATA()
DO F14
+4 ; validate DGFLDS
+5 ; INPUT("FLDS",file#,field#)=textname
+6 ; INPUT("FLDS",file#,textname)=field#
+7 SET X=$GET(DGFLDS)
IF $LENGTH(X)
Begin DoDot:1
+8 FOR I=1:1:$LENGTH(X,";")
SET Y=$PIECE(X,";",I)
Begin DoDot:2
+9 if Y=""
QUIT
if '$DATA(DATA(Y))
QUIT
+10 SET TX=$SELECT(Y=+Y:DATA(Y),1:Y)
+11 IF Y'=+Y
SET Y=DATA(TX)
+12 SET INPUT("FLDS",Y)=TX
SET INPUT("FLDS",TX)=Y
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 ; add in default fields if necessary
+16 SET X="ASSIGNDT"
IF '$DATA(INPUT("FLDS",X))
Begin DoDot:1
+17 SET INPUT("FLDS",.02)=X
SET INPUT("FLDS",X)=.02
+18 QUIT
End DoDot:1
+19 SET X="ACTION"
IF '$DATA(INPUT("FLDS",X))
Begin DoDot:1
+20 SET INPUT("FLDS",.03)=X
SET INPUT("FLDS",X)=.03
+21 QUIT
End DoDot:1
+22 ; validate DGACT
+23 SET DGACT=$GET(DGACT)
IF DGACT=""
QUIT 0
+24 SET X=$$GET1^DID(26.14,.03,,"SET OF CODES",,"DGERR")
+25 FOR I=1:1:$LENGTH(X,";")
SET Y=$PIECE(X,";",I)
if Y=""
QUIT
SET TMP(+Y)=$PIECE(Y,":",2)
+26 FOR I=1:1:$LENGTH(DGACT,";")
SET X=$PIECE(DGACT,";",I)
Begin DoDot:1
+27 IF +X
IF $DATA(TMP(X))
SET INPUT("ACT",X)=TMP(X)
+28 QUIT
End DoDot:1
+29 IF '$DATA(INPUT("ACT"))
QUIT 0
+30 ; validate DGBY
+31 SET X=$GET(DGBY)
SET X=$SELECT(X="":"I","ADI"[$EXTRACT(X):$EXTRACT(X),1:"I")
+32 SET INPUT("BY")=X
+33 QUIT 1
