- 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 Feb 19, 2025@00:13:23 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