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

RCDPEAA3.m

Go to the documentation of this file.
  1. RCDPEAA3 ;ALB/KML - APAR Screen - callable entry points ;Nov 24, 2014@23:32:24
  1. ;;4.5;Accounts Receivable;**298,304,318,332**;Mar 20, 1995;Build 40
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. SPLIT(RCIENS) ;EP - Protocol action - RCDPE APAR SPLINE LINE
  1. ; Split EEOB in APAR
  1. ; Input: RCIENS - Internal IEN of entry in file 344.49^ien of
  1. ; 344.491^selectable line item from listman screen
  1. N DIR,L,RCQUIT,X
  1. S RCQUIT=0
  1. D FULL^VALM1
  1. I '$D(^XUSEC("RCDPEPP",DUZ)) D Q ; PRCA*4.5*318 Added security key check
  1. . S VALMBCK="R"
  1. . W !!,"This action can only be taken by users that have the RCDPEPP security key.",!
  1. . D PAUSE^VALM1
  1. S L=0
  1. F S L=$O(^RCY(344.49,$P(RCIENS,U),1,$P(RCIENS,U,2),1,L)) Q:'L I "01"[$P($G(^(L,0)),U,2) D G SPLITQ
  1. . S DIR(0)="EA",DIR("A",1)="THIS EEOB IS NOT AVAILABLE TO EDIT/SPLIT",DIR("A")="PRESS RETURN TO CONTINUE "
  1. . W ! D ^DIR K DIR
  1. I $P($G(^RCY(344.49,$P(RCIENS,U),1,$P(RCIENS,U,2),0)),U,13) D G:RCQUIT SPLITQ
  1. . S DIR("A",1)="WARNING! THIS LINE HAS ALREADY BEEN VERIFIED",DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE?: ",DIR(0)="YA",DIR("B")="NO" W ! D ^DIR K DIR
  1. . I Y'=1 S RCQUIT=1
  1. K ^TMP("RCDPE_SPLIT_REBLD",$J)
  1. S X=+$O(^TMP("RCDPE-EOB_WLDX",$J,""),-1)
  1. D SPLIT^RCDPEWL3($P(RCIENS,U),X)
  1. I $G(^TMP("RCDPE_SPLIT_REBLD",$J)) K ^TMP("RCDPE_SPLIT_REBLD",$J) D INIT^RCDPEAA2(RCIENS)
  1. ;
  1. SPLITQ S VALMBCK="R"
  1. Q
  1. ;
  1. REFRESH(RCIENS) ;EP - Protocol action - RCDPE APAR EEOB REFRESH - PRCA*4.5*332 subroutine re-written
  1. ; Refresh the entry in file 344.49 to remove all user adjustments
  1. ; Input: RCIENS - Internal IEN of entry in file 344.49^ien of
  1. ; 344.491^selectable line item from listman screen
  1. N DA,DIK,DIR,DONE,IENS,OSEQ,SEQ,X,XX,Y,Z,ZZ,Z0
  1. D FULL^VALM1
  1. S XX=$P(RCIENS,"^",2)_","_$P(RCIENS,"^",1)_","
  1. S SEQ=$$GET1^DIQ(344.491,XX,.01,"I") ; Line Sequence #
  1. I '$D(^XUSEC("RCDPEPP",DUZ)) D Q ; PRCA*4.5*318 Added security key check
  1. . S VALMBCK="R"
  1. . W !!,"This action can only be taken by users that have the RCDPEPP security key.",!
  1. . D PAUSE^VALM1
  1. ;
  1. S DIR(0)="YA"
  1. S DIR("A",1)="This action will delete and rebuild this EEOB Worklist Scratch Pad for Line "_SEQ_"."
  1. S DIR("A",2)="All Splits/Edits/Reviews entered for this line will be erased and all entries"
  1. S DIR("A",3)="marked as manually verified will be unmarked.",DIR("A",4)=" "
  1. S DIR("A")="ARE YOU SURE YOU WANT TO DO THIS? "
  1. W !
  1. D ^DIR
  1. K DIR
  1. I Y'=1 D REFQ Q
  1. ;
  1. ; First remove Review and Verify information
  1. S DA=$P(RCIENS,"^",2),DA(1)=$P(RCIENS,"^",1)
  1. S DIE="^RCY(344.49,"_DA(1)_",1,",DA=$P(RCIENS,"^",2),DA(1)=$P(RCIENS,"^",1)
  1. S DR=".1///@;.11///@;.12///@;.13///@"
  1. D ^DIE
  1. S XX=0,DA(2)=DA(1),DA(1)=DA
  1. F D Q:'XX
  1. . S XX=$O(^RCY(344.49,DA(2),1,DA(1),4,XX))
  1. . Q:'XX
  1. . S DA=XX
  1. . S DIK="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,"
  1. . D ^DIK
  1. ;
  1. ; Next remove distributed adjustments
  1. S XX=0
  1. F D Q:'XX
  1. . S XX=$O(^RCY(344.49,DA(2),1,DA(1),1,XX))
  1. . Q:'XX
  1. . S DA=XX,DIK="^RCY(344.49,"_DA(2)_"1,"_DA(1)_",1,"
  1. . D ^DIK
  1. ;
  1. ; Finally remove Split/Edited lines
  1. K DA
  1. S IENS=$P(RCIENS,"^",2)_","_$P(RCIENS,"^",1)_","
  1. D GETS^DIQ(344.491,IENS,"**","I","OSEQ") ; Get Original line values
  1. S DA=$P(RCIENS,"^",2)+1,DA(1)=$P(RCIENS,"^",1)
  1. K DR
  1. S DIE="^RCY(344.49,"_DA(1)_",1,"
  1. S DR=".02///"_OSEQ(344.491,IENS,.02,"I")_";" ; Original Claim #
  1. S DR=DR_".03///"_OSEQ(344.491,IENS,.03,"I")_";" ; Amount to Post on Receipt
  1. S DR=DR_".04///"_OSEQ(344.491,IENS,.04,"I")_";" ; Include on Receipt
  1. S DR=DR_".05///"_OSEQ(344.491,IENS,.05,"I")_";" ; Amount of Payment
  1. S DR=DR_".06///"_OSEQ(344.491,IENS,.06,"I")_";" ; Net Amount of Payment
  1. ;
  1. ; PRCA*4.5*332 - AR Bill pointer goes in .07 field. It is populated during scratchpad creation
  1. ; but when refreshing we need to derive it from the old bill number in the .02 field.
  1. S Z0=""
  1. S ZZ=OSEQ(344.491,IENS,.02,"I")
  1. I ZZ'="" S Z0=$O(^DGCR(399,"B",ZZ,""))
  1. S DR=DR_".07///"_$S(Z0:Z0,1:"@")_";" ; AR Bill (399 or 430 IEN)
  1. ;
  1. S DR=DR_".08///@;.09///@;.10///@;2.03///@;2.04///@" ; Null out the other fields
  1. D ^DIE
  1. S XX=DA,DONE=0
  1. F D Q:DONE
  1. . S XX=$O(^RCY(344.49,DA(1),1,XX))
  1. . I 'XX S DONE=1 Q
  1. . Q:$P($P(^RCY(344.49,DA(1),1,XX,0),"^",1),".",1)'=SEQ ; Not line being refreshed
  1. . S DA=XX,DIK="^RCY(344.49,"_DA(1)_",1,"
  1. . D ^DIK
  1. ;
  1. D INIT^RCDPEAA2(RCIENS)
  1. REFQ ;
  1. S VALMBG=1,VALMBCK="R"
  1. Q
  1. ;
  1. RESEARCH ; Invoke the research menu off APAR
  1. ;
  1. K ^TMP($J,"RC_VALMBG")
  1. S ^TMP($J,"RC_VALMBG")=$G(VALMBG)
  1. D FULL^VALM1
  1. D EN^VALM("RCDPE APAR EEOB RESEARCH")
  1. RQ K ^TMP($J,"RC_VALMBG")
  1. Q
  1. ;
  1. VRECPT(RCIENS) ;
  1. ;
  1. ; Input - RCIENS = ien of entry in file 344.49^ien of 344.491^selectable line item from listman screen
  1. ;
  1. D VR^RCDPEWLP($P(RCIENS,U))
  1. Q
  1. REVIEW(RCIENS) ; Enter review information on worklist and turn review display on/off
  1. ;
  1. ; Input - RCIENS = ien of entry in file 344.49^ien of 344.491^selectable line item from listman screen
  1. ;
  1. ;
  1. N Z,RC,RCDA,RCZ,DIC,DA,DIE,DR,X,Y,DIR,REVCHG,RCUSPREF,RCLSTREV,RCREV
  1. D FULL^VALM1
  1. ;
  1. S REVCHG=""
  1. S DIR(0)="YA",RC=+$G(^TMP($J,"RC_REVIEW"))
  1. S DIR("A",1)="REVIEW DATA DISPLAY IS CURRENTLY TURNED "_$P("OFF^ON",U,RC+1),DIR("A")="DO YOU WANT TO TURN IT "_$P("ON^OFF",U,RC+1)_"?: ",DIR("B")=$S('RC:"YES",1:"NO") W ! D ^DIR K DIR
  1. I Y=1 S ^TMP($J,"RC_REVIEW")=((RC+1)#2),REVCHG=1
  1. S RCUSPREF=+$O(^RCY(344.49,$P(RCIENS,U),2,"B",DUZ,0))
  1. ;
  1. I 'RCUSPREF D ; Add the user pref record
  1. . S RCUSPREF=+$$ADDUSER($P(RCIENS,U),DUZ)
  1. S RCLSTREV=+$P($G(^RCY(344.49,$P(RCIENS,U),2,RCUSPREF,0)),U,2)
  1. S DA(1)=$P(RCIENS,U),DA=RCUSPREF
  1. I DA,RCLSTREV'=$G(^TMP($J,"RC_REVIEW")) D ; Update user pref
  1. . S DIE="^RCY(344.49,"_DA(1)_",2,",DR=".02////"_+$G(^TMP($J,"RC_REVIEW")) D ^DIE
  1. W !
  1. I '$G(^TMP($J,"RC_REVIEW")) G REVIEWQ
  1. ;
  1. D SEL^RCDPEWL(.RCDA)
  1. S RCZ=+$O(RCDA(0)),RCZ=+$G(RCDA(RCZ)) G:'RCZ REVIEWQ
  1. ;
  1. S RCREV=0
  1. I '$O(^RCY(344.49,$P(RCIENS,U),1,"AC",DUZ,RCZ,0)) D
  1. . S RCREV=$$NEWREV($P(RCIENS,U),RCZ,DUZ)
  1. E D
  1. . N DIR,X,Y
  1. . S DIR("A")="(A)DD or (E)DIT A REVIEW COMMENT?: ",DIR("B")="ADD",DIR(0)="SA^A:ADD;E:EDIT" W ! D ^DIR K DIR
  1. . I $D(DUOUT)!$D(DTOUT) Q
  1. . ;
  1. . I Y="E" D Q ; Edit a review entry entered by same user
  1. .. N DA,DR,DIE,X,Y
  1. .. S DA(1)=$P(RCIENS,U),DA=RCZ,DIC="^RCY(344.49,"_DA(1)_",1,"_DA_",4,",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,2)=DUZ" D ^DIC
  1. .. S RCREV=$S(Y>0:+Y,1:0)
  1. .. I RCREV S DA(2)=$P(RCIENS,U),DA(1)=RCZ,DA=RCREV,DIE="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,",DR=".03;.04////^S X=$$NOW^XLFDT()" D ^DIE
  1. . ;
  1. . S RCREV=$$NEWREV($P(RCIENS,U),RCZ,DUZ)
  1. ;
  1. I RCREV S DIE("NO^")="",DA(1)=$P(RCIENS,U),DA=RCZ,DIE="^RCY(344.49,"_DA(1)_",1,",DR=".11R;I X=0 S Y=""@10"";.12////^S X=DUZ;S Y=""@20"";@10;.12///@;@20" D ^DIE K DIE
  1. D INIT^RCDPEAA2(RCIENS)
  1. S REVCHG=""
  1. ;
  1. REVIEWQ I $G(REVCHG) D INIT^RCDPEAA2(RCIENS)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. NEWREV(RCSCR,RCZ,RCDUZ) ; Enter a new review comment
  1. ; RCSCR = ien of entry in file 344.49
  1. ; RCZ = ien of the EEOB (seq #)
  1. ; RCDUZ =DUZ of user entering the comment
  1. ; Function returns 0 if no new comment, ien of comment if added
  1. N DA,X,Y,DIC,DIK,DLAYGO,DO,DD,RCREV,RCNOW
  1. S RCNOW=$$NOW^XLFDT() W !!,"REVIEW DATE/TIME: "_$$FMTE^XLFDT(RCNOW,"2")
  1. S DA(2)=RCSCR,DA(1)=RCZ,X=RCNOW,DIC("DR")=".02////"_RCDUZ_";.03",DLAYGO=344.492,DIC(0)="L"
  1. S DIC="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,"
  1. K DO,DD
  1. D FILE^DICN K DO,DD,DIC,DLAYGO
  1. S RCREV=+Y
  1. I RCREV'>0 S RCREV=0 G NEWREVQ
  1. I '$O(^RCY(344.49,DA(2),1,DA(1),4,RCREV,0)) S DIK="^RCY(344.49,"_DA(2)_",1,"_DA(1)_",4,",DA=RCREV D ^DIK S RCREV=0 ; No comment - delete entry
  1. ;
  1. NEWREVQ Q RCREV
  1. ;
  1. ADDUSER(RCSCR,RCDUZ) ; Add user record to user preferences multiple in file 344.49 and initialize all preferences
  1. ; RCSCR = ien of entry in file 344.49
  1. ; RCDUZ = the ien of the user
  1. N DIC,DA,X,Y,DLAYGO,DO,DD
  1. S Y=+$O(^RCY(344.49,RCSCR,2,"B",RCDUZ,0))
  1. I Y G ADDUQ
  1. S DLAYGO=344.492,DA(1)=RCSCR,DIC(0)="L",X=RCDUZ,DIC="^RCY(344.49,"_DA(1)_",2,",DIC("DR")=".02////0;.03////N"
  1. D FILE^DICN K DIC,DLAYGO
  1. ADDUQ Q $S(Y>0:Y,1:0)
  1. ;
  1. PREOB(RCIENS) ; Print/View EOB detail
  1. N RCDA,RCDAZ,Z,Z0
  1. D FULL^VALM1
  1. S RCDA=$P($G(^RCY(344.49,$P(RCIENS,U),1,$P(RCIENS,U,2),0)),U,9)
  1. F RCDAZ=1:1:$L(RCDA,",") S RCDAZ(RCDAZ)=$P(RCDA,",",RCDAZ)
  1. S Z=0 F S Z=$O(RCDAZ(Z)) Q:'Z D
  1. . ;
  1. . S Z0=RCDAZ(Z)
  1. . I $E(Z0,1,3)="ADJ" D Q
  1. .. I $G(^RCY(344.4,RCSCR,2,+$P(Z0,"ADJ",2),0))'="" S RCDAZ(Z)="ADJ^"_+$P(Z0,"ADJ",2)
  1. . ;
  1. . S Z0=$G(^RCY(344.4,$P(RCIENS,U),1,+Z0,0))
  1. . S RCDAZ(Z)=+Z0_U_$S($P(Z0,U,2):$P(Z0,U,2),1:-1) Q
  1. ;
  1. D VP^RCDPEWL2($P(RCIENS,U),.RCDAZ)
  1. ;
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. VERIF(RCIENS) ;EP - Protocol action RCDPE APAR VERIFY
  1. ; Entry point to verification options on APAR worklist
  1. ; Input: RCIENS - Internal IEN of entry in file 344.49^ien of
  1. ; 344.491^selectable line item from listman screen
  1. N DIR,DIRUT,DTOUT,DUOUT,RCQUIT,X,Y
  1. D FULL^VALM1
  1. I '$D(^XUSEC("RCDPEPP",DUZ)) D Q ; PRCA*4.5*318 Added security key check
  1. . S VALMBCK="R"
  1. . W !!,"This action can only be taken by users that have the RCDPEPP security key.",!
  1. . D PAUSE^VALM1
  1. ;
  1. W !!!!
  1. S RCQUIT=0
  1. F D Q:RCQUIT
  1. . S DIR(0)="SAO^1:MANUAL VERIFICATION;2:REPORT UNVERIFIED DISCREPANCIES;3:QUIT"
  1. . S DIR("A",1)="VERIFY EEOBs:"
  1. . S DIR("A",2)=" 1 MANUALLY MARK AS VERIFIED"
  1. . S DIR("A",3)=" 2 REPORT OF UNVERIFIED WITH DISCREPANCIES"
  1. . S DIR("A",4)=" 3 QUIT AND RETURN TO WORKLIST"
  1. . S DIR("A")="Select Action: ",DIR("B")="QUIT" W ! D ^DIR K DIR
  1. . I Y=3!(Y="")!$D(DUOUT)!$D(DTOUT) S RCQUIT=1 Q
  1. . ;
  1. . I Y=1 D MVER($P(RCIENS,U)) W !! Q
  1. . ;
  1. . I Y=2 D RPT^RCDPEV0($P(RCIENS,U)) W !! Q
  1. ;
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. MVER(RCERA) ; Manually mark an EEOB as verified within APAR
  1. ; subroutine cloned from the process that VERIFIES EEOBs off the standard worklist (MVER^RCDPEV)
  1. ; but with specific changes to support APAR
  1. ; this subroutine only needs to VERIFY one EEOB rather than a list of EEOBs
  1. N A,CT,DA,DIE,DR,DTOUT,DUOUT,Z,Z0,Z1,RCT,RCY,RCY0,RCZ0,RCLINE,RCYNUM,DIR,X,Y,RESULT,SPLIT,Q,Q0,DT1,DT2
  1. N VERIFIED
  1. S (VERIFIED,RCT)=0,CT=1,Z0=""
  1. ; get the EEOB entry ien to determine if already it's already been verified
  1. S Z1=$O(^TMP("RCDPE-EOB_WLDX",$J,"")) I Z1 S Z=^TMP("RCDPE-EOB_WLDX",$J,Z1)
  1. ; grab the data belonging to the EEOB
  1. I Z]"" S Z0=$G(^RCY(344.49,RCERA,1,+$P(Z,U,2),0))
  1. ; get VERIFY data
  1. I Z0'="",$P(Z0,U,13) S VERIFIED=1
  1. I VERIFIED D Q
  1. . S DIR(0)="EA",DIR("A",1)="THIS EEOB IS ALREADY VERIFIED",DIR("A")="PRESS RETURN TO CONTINUE: " W ! D ^DIR K DIR
  1. S RCY=+$P($G(^TMP("RCDPE-EOB_WLDX",$J,Z1)),U,2),RCLINE=+^(Z1),RCYNUM=Z1
  1. S RCY0=$G(^RCY(344.49,RCERA,1,RCY,0))
  1. S RCZ0=$G(^RCY(344.4,RCERA,1,+$P(RCY0,U,9),0))
  1. I '$P(RCZ0,U,2) D
  1. . W !!,"THIS LINE DOES NOT REFERENCE A VALID BILL"
  1. E D
  1. . S RESULT=$$VER^RCDPEV(RCERA,+$G(^IBM(361.1,+$P(RCZ0,U,2),0)),+$P(RCY0,U,9),1)
  1. . F Z=2:1:9 I $E($P(RESULT,U,Z))="*" S Q=$P(RESULT,U,Z),$E(Q,1)="",$P(RESULT,U,Z)=Q
  1. . S SPLIT=$O(^RCY(344.49,RCERA,1,"B",+RCY0_".9999"),-1)'=(+RCY0_".0001")
  1. . S Z=$S(SPLIT:"CLAIM #'s: ",1:" CLAIM #: ")
  1. . S Z=Z_$P(RCY0,U,2)_$S('SPLIT:"",1:" (ORIGINAL ERA DATA)")
  1. . I SPLIT D
  1. .. S Q=+RCY0 F S Q=$O(^RCY(344.49,RCERA,1,"B",Q)) Q:(Q\1)'=+RCY0 S Q0=+$O(^RCY(344.49,RCERA,1,"B",Q,0)),Q0=$G(^RCY(344.49,RCERA,1,Q0,0)) I $P(Q0,U,2)'="" S Z=Z_" "_$P(Q0,U,2)
  1. . W !!!,Z
  1. . W !,?13,"PATIENT NAME"_$J("",18)_" SUBMITTED AMT SVC DATE(S)"
  1. . W !,?13,"------------------------------ --------------- -----------------"
  1. . S DT1=$E($S($P(RESULT,U,7):$$FMTE^XLFDT($P(RESULT,U,7),"2D"),1:"NOTFOUND")_$J("",8),1,8)
  1. . S DT2=$E($S($P(RESULT,U,9):"-"_$$FMTE^XLFDT($P(RESULT,U,9),"2D"),1:"-NOTFOUND")_$J("",9),1,9)
  1. . W !," ERA DATA: ",$E($P(RESULT,U,3)_$J("",30),1,30)," ",$E($J($P(RESULT,U,5),"",2)_$J("",15),1,15)_" "_DT1_DT2
  1. . W !,?15,$P($G(^RCY(344,RCERA,0)),U,6)
  1. . S DT1=$E($S($P(RESULT,U,6):$$FMTE^XLFDT($P(RESULT,U,6),"2D"),1:"NOTFOUND")_$J("",8),1,8)
  1. . S DT2=$E($S($P(RESULT,U,8):"-"_$$FMTE^XLFDT($P(RESULT,U,8),"2D"),1:"-NOTFOUND")_$J("",9),1,9)
  1. . W !," BILL DATA: "_$E($P(RESULT,U,2)_$J("",30),1,30)_" "_$E($J($P(RESULT,U,4),"",2)_$J("",15),1,15)_" "_DT1_DT2
  1. . W !,?15,$P($G(^DIC(36,+$P(RCZ0,U,4),0)),U),!
  1. S DIR(0)="YA",DIR("A")="DO YOU WANT TO MARK THIS LINE VERIFIED? ",DIR("B")="NO" W ! D ^DIR K DIR
  1. ;
  1. I Y'=1 Q
  1. S DA(1)=RCERA,DA=+RCY,DIE="^RCY(344.49,"_DA(1)_",1,",DR=".13////1" D ^DIE
  1. S A=$$TOPLINE^RCDPEWL1($G(^RCY(344.49,RCERA,1,+RCY,0)),RCYNUM)
  1. S ^TMP("RCDPE-EOB_WL",$J,RCLINE,0)=A
  1. Q
  1. ;
  1. ;PRCA*4.5*304 - add a claim comment to the ERA detail line from APAR
  1. COMNT ;
  1. N IEN,SEQ,DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT,ZDA,ZBILL,RCOMMENT,TCOMM
  1. S RCOMMENT=0
  1. S IEN=+$P(RCIENS,U,1)
  1. ; Validate the selection
  1. I IEN=0 D G COMQ
  1. . W !,"Cannot comment, no record in file ELECTRONIC REMITTANCE ADVICE file selected." D WAIT^VALM1
  1. S SEQ=$P(^RCY(344.49,IEN,1,+$P(RCIENS,U,2),0),U,9) ; Just grab the first sequence number for the comment.
  1. I $G(SEQ)="" D G COMQ
  1. . W !,"Cannot comment, no ERA detail record selected." D WAIT^VALM1
  1. I $G(^RCY(344.4,IEN,1,SEQ,0))']"" D G COMQ
  1. . W !,"Cannot comment, ERA detail record selected not found." D WAIT^VALM1
  1. ;
  1. ; Allow user to put comment on this ERA Detail record
  1. S ZDA=SEQ,ZDA(1)=IEN,ZBILL=$P($$GETBILL^RCDPESR0(.ZDA),"-",2)
  1. W !,"Enter a comment on ERA #"_IEN_" ERA Detail Seq #",SEQ," Bill #",ZBILL,!
  1. S DIE="^RCY(344.4,"_IEN_",1,",DA=SEQ,DA(1)=IEN,DR="4Comment" D ^DIE G:$D(DTOUT)!$D(Y) COMQ
  1. ; Now file user (DUZ) and DATE
  1. K DR
  1. ; If DA is not defined then the user deleted the comment with an @,
  1. ; Delete the user and date too.
  1. S TCOMM=$$GET1^DIQ(344.41,SEQ_","_IEN_",",4,"E")
  1. I TCOMM="" S DA=SEQ,DA(1)=IEN,DR="4.01////@;4.02////@;"
  1. E S DR="4.01////"_$$DT^XLFDT_";4.02////"_$G(DUZ)_";"
  1. D ^DIE
  1. S RCOMMENT=1
  1. D WAIT^VALM1
  1. ;
  1. COMQ I RCOMMENT D INIT^RCDPEAA2(RCIENS) ;
  1. S VALMBCK="R"
  1. Q