- RCDPEX0 ;ALB/TMK - 837 EDI RETURN MSG EXTRACT MAIN LIST TEMPLATE ;02-MAY-96
- ;;4.5;Accounts Receivable;**173**;Mar 20, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- SCRIT(RCSCRIT) ; Enter display selection criteria
- ; Pass RCSCRIT by reference - returned containing selection criteria
- ; RCSCRIT(n)=n-level sort RCSCRIT(n,1-x)=selections
- ; RCSCRIT(n,"D1") = from DATE range RCSCRIT(n,"D2") = to DATE range
- N DIR,X,Y
- D FULL^VALM1
- W !
- S DIR("B")="ALL"
- S DIR("A",1)="Enter sort and selection criteria for message list",DIR("A",2)=" ",DIR("A")="First level sort field: "
- S DIR(0)="SA^MT:TYPE OF MESSAGE;ER:TYPE OF ERROR;ALL:ALL MESSAGES"
- S DIR("?")="Enter the top-level sort for the list of messages"
- D ^DIR K DIR
- I $D(DIRUT) K RCSCRIT Q
- S RCSCRIT(1)=Y
- I Y="ALL" Q
- D SELECT(1,.RCSCRIT) Q:'$D(RCSCRIT)
- S DIR("A",1)=" ",DIR("A")="Second level sort field: "
- S DIR(0)="SAO^"_$S($S(RCSCRIT(1)'="MT":"MT:TYPE OF MESSAGE;",1:"")_RCSCRIT(1)'="MS":"ER:TYPE OF ERROR;",1:"")_"MD:ERA MESSAGE DATE;RD:ERA RECORDED DATE"
- S DIR("?")="Enter the second-level sort for the list of messages"
- S DIR("?",1)="First level sort selected was: "_$$FLD(RCSCRIT(1))
- D ^DIR K DIR
- I $D(DTOUT)!$D(DUOUT) K RCSCRIT Q
- I Y="" Q
- S RCSCRIT(2)=Y
- D SELECT(2,.RCSCRIT) Q:'$D(RCSCRIT)
- S DIR("A",1)=" ",DIR("A")="Third level sort field: "
- S DIR(0)="SAO^"
- S DIR(0)=DIR(0)_$S(RCSCRIT(1)'="MT"&(RCSCRIT(2)'="MT"):"MT:TYPE OF MESSAGE;",1:"")_$S(RCSCRIT(1)'="ER"&(RCSCRIT(2)'="ER"):"ER:TYPE OF ERROR",1:"")
- S DIR(0)=DIR(0)_$S(RCSCRIT(2)'="MD":"MD:ERA MESSAGE DATE;",1:"")_$S(RCSCRIT(2)'="RD":"RD:ERA RECORDED DATE",1:"")
- S DIR("?")="Enter the third-level sort for the list of messages"
- D ^DIR K DIR
- I $D(DTOUT)!$D(DUOUT) K RCSCRIT Q
- I Y="" Q
- S RCSCRIT(3)=Y
- D SELECT(3,.RCSCRIT)
- Q
- ;
- SELECT(LEVEL,RCSCRIT) ; Select specific or all values/date range for RCSCRIT(LEVEL)
- ; LEVEL = sort level 1-3
- N SELNM,SEL,CT,Y,DIR,DUOUT,DTOUT,DIRUT,X,Z
- S SEL=$G(RCSCRIT(LEVEL)) I SEL="" K RCSCRIT Q
- S SELNM=$$FLD(SEL)
- RESEL S DIR("A")="Do you want ALL "_SELNM_"'s",DIR(0)="Y",DIR("?")="ANSWER YES TO INCLUDE ALL "_SELNM_" OR NO TO SELECT SPECIFIC VALUES OR RANGES"
- D ^DIR K DIR
- I $D(DIRUT) K RCSCRIT Q
- I Y=1 Q
- I SEL="MD"!(SEL="RD") D Q ;Date field
- . S DIR("A")="From Date: ",DIR(0)="DA^:"_DT_":P",DIR("?")="Enter the earliest date you want included in the list" D ^DIR
- . I $D(DIRUT) K RCSCRIT Q
- . S RCSCRIT(LEVEL,"D1")=Y I 'X W " ",$$FMTE^XLFDT(Y,2)
- . S DIR("A")="To Date: ",DIR(0)="DA^:"_DT_":P",DIR("?")="Enter the latest date you want included in the list" D ^DIR
- . I $D(DIRUT) K RCSCRIT Q
- . S RCSCRIT(LEVEL,"D2")=Y I 'X W " ",$$FMTE^XLFDT(Y,2)
- S CT=0
- S DIR("A",1)=" ",DIR("A",2)="Enter your selections one at a time.",DIR("A",3)="When done, press return at the "_SELNM_" prompt to continue."
- S DIR("A")=SELNM_": ",DIR(0)=$S(SEL="ER":"344.5,.1",SEL="MT":"344.5,.02",1:"")_"AO"
- F D ^DIR D Q:"^"[Y
- . Q:$D(DUOUT)
- . I Y="" Q:CT W !,*7,"You must select at least one entry" S Y=-1 Q
- . S CT=CT+1,RCSCRIT(LEVEL,$P(Y,U))=Y
- . I $D(DIR("A",1)) F Z=1:1:3 K DIR("A",Z)
- K DIR
- I $D(DUOUT)!$D(DTOUT) D I $D(RCSCRIT) K RCSCRIT(LEVEL) S RCSCRIT(LEVEL)=SEL G RESEL
- . S DIR(0)="Y",DIR("A",1)=" ",DIR("A")="Do you want to abort this entire sort/selection"
- . S DIR("?")="Answer YES if you want to abort or to re-enter all sort/selection criteria",DIR("?",1)="Answer NO if you want to re-enter just this sort level's criteria"
- . D ^DIR K DIR
- . I $D(DIRUT)!Y K RCSCRIT
- Q
- ;
- FLD(FLD) ; RETURN NAME OF FIELD
- Q $S(FLD="ER":"ERROR CATEGORY",FLD="MT":"TYPE OF MESSAGE",FLD="MD":"MESSAGE DATE",FLD="RD":"DATE RECORDED",1:"")
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEX0 3715 printed Mar 13, 2025@20:50:35 Page 2
- RCDPEX0 ;ALB/TMK - 837 EDI RETURN MSG EXTRACT MAIN LIST TEMPLATE ;02-MAY-96
- +1 ;;4.5;Accounts Receivable;**173**;Mar 20, 1995
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- SCRIT(RCSCRIT) ; Enter display selection criteria
- +1 ; Pass RCSCRIT by reference - returned containing selection criteria
- +2 ; RCSCRIT(n)=n-level sort RCSCRIT(n,1-x)=selections
- +3 ; RCSCRIT(n,"D1") = from DATE range RCSCRIT(n,"D2") = to DATE range
- +4 NEW DIR,X,Y
- +5 DO FULL^VALM1
- +6 WRITE !
- +7 SET DIR("B")="ALL"
- +8 SET DIR("A",1)="Enter sort and selection criteria for message list"
- SET DIR("A",2)=" "
- SET DIR("A")="First level sort field: "
- +9 SET DIR(0)="SA^MT:TYPE OF MESSAGE;ER:TYPE OF ERROR;ALL:ALL MESSAGES"
- +10 SET DIR("?")="Enter the top-level sort for the list of messages"
- +11 DO ^DIR
- KILL DIR
- +12 IF $DATA(DIRUT)
- KILL RCSCRIT
- QUIT
- +13 SET RCSCRIT(1)=Y
- +14 IF Y="ALL"
- QUIT
- +15 DO SELECT(1,.RCSCRIT)
- if '$DATA(RCSCRIT)
- QUIT
- +16 SET DIR("A",1)=" "
- SET DIR("A")="Second level sort field: "
- +17 SET DIR(0)="SAO^"_$SELECT($SELECT(RCSCRIT(1)'="MT":"MT:TYPE OF MESSAGE;",1:"")_RCSCRIT(1)'="MS":"ER:TYPE OF ERROR;",1:"")_"MD:ERA MESSAGE DATE;RD:ERA RECORDED DATE"
- +18 SET DIR("?")="Enter the second-level sort for the list of messages"
- +19 SET DIR("?",1)="First level sort selected was: "_$$FLD(RCSCRIT(1))
- +20 DO ^DIR
- KILL DIR
- +21 IF $DATA(DTOUT)!$DATA(DUOUT)
- KILL RCSCRIT
- QUIT
- +22 IF Y=""
- QUIT
- +23 SET RCSCRIT(2)=Y
- +24 DO SELECT(2,.RCSCRIT)
- if '$DATA(RCSCRIT)
- QUIT
- +25 SET DIR("A",1)=" "
- SET DIR("A")="Third level sort field: "
- +26 SET DIR(0)="SAO^"
- +27 SET DIR(0)=DIR(0)_$SELECT(RCSCRIT(1)'="MT"&(RCSCRIT(2)'="MT"):"MT:TYPE OF MESSAGE;",1:"")_$SELECT(RCSCRIT(1)'="ER"&(RCSCRIT(2)'="ER"):"ER:TYPE OF ERROR",1:"")
- +28 SET DIR(0)=DIR(0)_$SELECT(RCSCRIT(2)'="MD":"MD:ERA MESSAGE DATE;",1:"")_$SELECT(RCSCRIT(2)'="RD":"RD:ERA RECORDED DATE",1:"")
- +29 SET DIR("?")="Enter the third-level sort for the list of messages"
- +30 DO ^DIR
- KILL DIR
- +31 IF $DATA(DTOUT)!$DATA(DUOUT)
- KILL RCSCRIT
- QUIT
- +32 IF Y=""
- QUIT
- +33 SET RCSCRIT(3)=Y
- +34 DO SELECT(3,.RCSCRIT)
- +35 QUIT
- +36 ;
- SELECT(LEVEL,RCSCRIT) ; Select specific or all values/date range for RCSCRIT(LEVEL)
- +1 ; LEVEL = sort level 1-3
- +2 NEW SELNM,SEL,CT,Y,DIR,DUOUT,DTOUT,DIRUT,X,Z
- +3 SET SEL=$GET(RCSCRIT(LEVEL))
- IF SEL=""
- KILL RCSCRIT
- QUIT
- +4 SET SELNM=$$FLD(SEL)
- RESEL SET DIR("A")="Do you want ALL "_SELNM_"'s"
- SET DIR(0)="Y"
- SET DIR("?")="ANSWER YES TO INCLUDE ALL "_SELNM_" OR NO TO SELECT SPECIFIC VALUES OR RANGES"
- +1 DO ^DIR
- KILL DIR
- +2 IF $DATA(DIRUT)
- KILL RCSCRIT
- QUIT
- +3 IF Y=1
- QUIT
- +4 ;Date field
- IF SEL="MD"!(SEL="RD")
- Begin DoDot:1
- +5 SET DIR("A")="From Date: "
- SET DIR(0)="DA^:"_DT_":P"
- SET DIR("?")="Enter the earliest date you want included in the list"
- DO ^DIR
- +6 IF $DATA(DIRUT)
- KILL RCSCRIT
- QUIT
- +7 SET RCSCRIT(LEVEL,"D1")=Y
- IF 'X
- WRITE " ",$$FMTE^XLFDT(Y,2)
- +8 SET DIR("A")="To Date: "
- SET DIR(0)="DA^:"_DT_":P"
- SET DIR("?")="Enter the latest date you want included in the list"
- DO ^DIR
- +9 IF $DATA(DIRUT)
- KILL RCSCRIT
- QUIT
- +10 SET RCSCRIT(LEVEL,"D2")=Y
- IF 'X
- WRITE " ",$$FMTE^XLFDT(Y,2)
- End DoDot:1
- QUIT
- +11 SET CT=0
- +12 SET DIR("A",1)=" "
- SET DIR("A",2)="Enter your selections one at a time."
- SET DIR("A",3)="When done, press return at the "_SELNM_" prompt to continue."
- +13 SET DIR("A")=SELNM_": "
- SET DIR(0)=$SELECT(SEL="ER":"344.5,.1",SEL="MT":"344.5,.02",1:"")_"AO"
- +14 FOR
- DO ^DIR
- Begin DoDot:1
- +15 if $DATA(DUOUT)
- QUIT
- +16 IF Y=""
- if CT
- QUIT
- WRITE !,*7,"You must select at least one entry"
- SET Y=-1
- QUIT
- +17 SET CT=CT+1
- SET RCSCRIT(LEVEL,$PIECE(Y,U))=Y
- +18 IF $DATA(DIR("A",1))
- FOR Z=1:1:3
- KILL DIR("A",Z)
- End DoDot:1
- if "^"[Y
- QUIT
- +19 KILL DIR
- +20 IF $DATA(DUOUT)!$DATA(DTOUT)
- Begin DoDot:1
- +21 SET DIR(0)="Y"
- SET DIR("A",1)=" "
- SET DIR("A")="Do you want to abort this entire sort/selection"
- +22 SET DIR("?")="Answer YES if you want to abort or to re-enter all sort/selection criteria"
- SET DIR("?",1)="Answer NO if you want to re-enter just this sort level's criteria"
- +23 DO ^DIR
- KILL DIR
- +24 IF $DATA(DIRUT)!Y
- KILL RCSCRIT
- End DoDot:1
- IF $DATA(RCSCRIT)
- KILL RCSCRIT(LEVEL)
- SET RCSCRIT(LEVEL)=SEL
- GOTO RESEL
- +25 QUIT
- +26 ;
- FLD(FLD) ; RETURN NAME OF FIELD
- +1 QUIT $SELECT(FLD="ER":"ERROR CATEGORY",FLD="MT":"TYPE OF MESSAGE",FLD="MD":"MESSAGE DATE",FLD="RD":"DATE RECORDED",1:"")
- +2 ;
