- PRCOER ;WISC/DJM-EDI REPORTS USING LIST MANAGER ; [10/20/98 11:58am]
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- EN ; -- main entry point for PRCO EDI REPORTS
- ; First lets see if there is anything to report. If not - exit.
- Q:$G(PRCOFLG)=-1
- N LIST,LIST1,LIST2,PO,PRCO
- S LIST=""
- S LIST=$O(^PRC(443.75,"AC",LIST))
- S LIST1=""
- S LIST1=$O(^PRC(443.75,"AF",LIST1))
- S LIST2=""
- S LIST2=$O(^PRC(443.75,"AO",LIST2))
- I LIST="",LIST1="",LIST2="" G NOTHING
- N X
- I '$D(IOF)!('$G(IOST(0))) S IOP="HOME" D ^%ZIS K IOP
- S X="IORVON;IORVOFF" D ENDR^%ZISS
- S PRCO("RV1")=$G(IORVON)
- S PRCO("RV0")=$G(IORVOFF)
- S PRCO("XY")="N DX,DY S (DX,DY)=0 "_$G(^%ZOSF("XY"))
- D EN^VALM("PRCO EDI REPORTS")
- Q
- ;
- HDR ; -- header code
- S VALMHDR(1)="EDI Transactions from IFCAP Reports"
- I SENDER>0 D
- . S NAME=$P($G(^VA(200,SENDER,0)),U)
- . S VALMHDR(1)=VALMHDR(1)_" Sender is "_NAME
- . Q
- Q
- ;
- INIT ; -- init variables and list array
- N COUNT,DATE,LINENO,LIST,LIST0,LIST1,LIST2,ERROR,REJECT,RFQ,TXT,TYPE,VENDOR,VENDOR1
- K ^PRC(443.75,"PRCOER",$J)
- S LIST=""
- S LIST=$O(^PRC(443.75,"AC",LIST))
- S LIST1=""
- S LIST1=$O(^PRC(443.75,"AF",LIST1))
- S LIST2=""
- S LIST2=$O(^PRC(443.75,"AO",LIST2))
- I LIST="",LIST1="",LIST2="" G NOTHING
- D CLEAN^VALM10
- S COUNT=0
- S LINENO=0
- G:SENDER>0 INIT0
- ;
- ; First list all PROGRESS LEVEL 3 records.
- ;
- S LIST=""
- F S LIST=$O(^PRC(443.75,"AM",3,LIST)) Q:LIST="" D
- . S LIST0=""
- . F S LIST0=$O(^PRC(443.75,"AM",3,LIST,LIST0),-1) Q:LIST0="" D
- . . S LIST1=""
- . . F S LIST1=$O(^PRC(443.75,"AM",3,LIST,LIST0,LIST1)) Q:LIST1="" D
- . . . S LIST2=$G(^PRC(443.75,LIST1,0))
- . . . Q:LIST2=""
- . . . D INIT1
- . . . Q
- . . Q
- . Q
- ;
- ; Next list all PROGRESS LEVEL 2 records.
- ;
- S LIST=""
- F S LIST=$O(^PRC(443.75,"AL",2,LIST)) Q:LIST="" D
- . S LIST0=""
- . F S LIST0=$O(^PRC(443.75,"AL",2,LIST,LIST0),-1) Q:LIST0="" D
- . . S LIST1=""
- . . F S LIST1=$O(^PRC(443.75,"AL",2,LIST,LIST0,LIST1)) Q:LIST1="" D
- . . . S LIST2=$G(^PRC(443.75,LIST1,0))
- . . . Q:LIST2=""
- . . . D INIT1
- . . . Q
- . . Q
- . Q
- ;
- ; Last list all PROGRESS LEVEL 1 records.
- ;
- S LIST=""
- F S LIST=$O(^PRC(443.75,"AJ",1,LIST)) Q:LIST="" D
- . S LIST0=""
- . F S LIST0=$O(^PRC(443.75,"AJ",1,LIST,LIST0),-1) Q:LIST0="" D
- . . S LIST1=""
- . . F S LIST1=$O(^PRC(443.75,"AJ",1,LIST,LIST0,LIST1)) Q:LIST1="" D
- . . . S LIST2=$G(^PRC(443.75,LIST1,0))
- . . . Q:LIST2=""
- . . . D INIT1
- . . . Q
- . . Q
- . Q
- ;
- ; Now lets show the list to the users.
- ;
- S VALMCNT=COUNT
- Q
- ;
- INIT0 ; Come here if the user selected one sender to view.
- ;
- ; First list all PROGRESS LEVEL 3 records for SENDER.
- ;
- S LIST=""
- F S LIST=$O(^PRC(443.75,"AM1",3,SENDER,LIST)) Q:LIST="" D
- . S LIST0=""
- . F S LIST0=$O(^PRC(443.75,"AM1",3,SENDER,LIST,LIST0),-1) Q:LIST0="" D
- . . S LIST1=""
- . . F S LIST1=$O(^PRC(443.75,"AM1",3,SENDER,LIST,LIST0,LIST1)) Q:LIST1="" D
- . . . S LIST2=$G(^PRC(443.75,LIST1,0))
- . . . Q:LIST2=""
- . . . D INIT1
- . . . Q
- . . Q
- . Q
- ;
- ; Next list all PROGRESS LEVEL 2 records for SENDER.
- ;
- S LIST=""
- F S LIST=$O(^PRC(443.75,"AL1",2,SENDER,LIST)) Q:LIST="" D
- . S LIST0=""
- . F S LIST0=$O(^PRC(443.75,"AL1",2,SENDER,LIST,LIST0),-1) Q:LIST0="" D
- . . S LIST1=""
- . . F S LIST1=$O(^PRC(443.75,"AL1",2,SENDER,LIST,LIST0,LIST1)) Q:LIST1="" D
- . . . S LIST2=$G(^PRC(443.75,LIST1,0))
- . . . Q:LIST2=""
- . . . D INIT1
- . . . Q
- . . Q
- . Q
- ;
- ; Last list all PROGRESS LEVEL 1 records for SENDER.
- ;
- S LIST=""
- F S LIST=$O(^PRC(443.75,"AJ1",1,SENDER,LIST)) Q:LIST="" D
- . S LIST0=""
- . F S LIST0=$O(^PRC(443.75,"AJ1",1,SENDER,LIST,LIST0),-1) Q:LIST0="" D
- . . S LIST1=""
- . . F S LIST1=$O(^PRC(443.75,"AJ1",1,SENDER,LIST,LIST0,LIST1)) Q:LIST1="" D
- . . . S LIST2=$G(^PRC(443.75,LIST1,0))
- . . . Q:LIST2=""
- . . . D INIT1
- . . . Q
- . . Q
- . Q
- ;
- ; Now lets show the list to the users.
- ;
- S VALMCNT=COUNT
- Q
- ;
- INIT1 ; ENTER DATA FROM THE RECORD CHOOSEN.
- ;
- S PO=$P(LIST2,U,2)
- S TXT=+$P(LIST2,U,3)
- S RFQ=+$P(LIST2,U,10)
- S RFQ=$S(RFQ=0:"O",1:"C")
- S TYPE=$P(LIST2,U,4)
- S TXT=$S(TYPE="TXT":TXT,TYPE="RFQ":RFQ,1:"")
- S VENDOR=$P(LIST2,U,6)
- S DATE=$P($P(LIST2,U,7),".",1)
- ;
- I TYPE="PHA" D
- . I '$D(^PRC(440,"AG",VENDOR)) S VENDOR="Not Found" Q
- . S VENDOR=$O(^PRC(440,"AG",VENDOR,""))
- . S VENDOR=$E($P($G(^PRC(440,VENDOR,0)),U),1,30)
- . I VENDOR']"" S VENDOR="Not Found"
- . Q
- ;
- I TYPE'="PHA" D
- . I VENDOR="PUBLIC" Q
- . S:$E(VENDOR,1,3)'="DUN" VENDOR="DUN"_VENDOR
- . S VENDOR1=$O(^PRC(440,"DB",VENDOR,""))
- . I VENDOR1>0 S VENDOR=$E($P($G(^PRC(440,VENDOR1,0)),U),1,30) Q
- . S VENDOR1=$O(^PRC(444.1,"DB",VENDOR,""))
- . I VENDOR1>0 S VENDOR=$E($P($G(^PRC(444.1,VENDOR1,0)),U),1,30) Q
- . I VENDOR']"" S VENDOR="Not Found"
- . Q
- ;
- S LIST2=$G(^PRC(443.75,LIST1,1))
- S REJECT=$P(LIST2,U,7)
- S ERROR=$P(LIST2,U,12)
- S:$P(LIST2,U,1)]"" TYPE=$P(LIST2,U,1)
- S:$P(LIST2,U,15)]"" TYPE=$P(LIST2,U,15)
- ;
- ; IN THE NEXT LINE THE $S DEFAULT - THE 1:PART AT THE END- WILL BE
- ; 'POA' IN THE TYPE VARIABLE.
- ;
- S DATE=$S(",PHA,RFQ,TXT,"[TYPE:DATE,",ACT,PRJ,"[TYPE:$P($P(LIST2,U,2),".",1),1:$P($P(LIST2,U,16),"."))
- S DATE=+$E(DATE,4,5)_"/"_+$E(DATE,6,7)_"/"_(+$E(DATE,1,3)+1700)
- S COUNT=COUNT+1
- S X=$$SETFLD^VALM1(COUNT,"","NUMBER")
- S X=$$SETFLD^VALM1(PO,X,"PO")
- S X=$$SETFLD^VALM1(TXT,X,"TXT/RFQ")
- S X=$$SETFLD^VALM1(TYPE,X,"TYPE")
- S X=$$SETFLD^VALM1(VENDOR,X,"VENDOR")
- S X=$$SETFLD^VALM1(REJECT,X,"REJECT")
- S X=$$SETFLD^VALM1(ERROR,X,"ERROR")
- S X=$$SETFLD^VALM1(DATE,X,"DATE")
- S LINENO=LINENO+1
- D SET^VALM10(COUNT,X,LINENO)
- S ^PRC(443.75,"PRCOER",$J,LINENO)=COUNT_"^"_LIST1
- Q
- ;
- HELP ; -- help code
- I X["??" G HELP1
- ;
- D EN^DDIOL("Select one of the valid actions above, or enter '??' for extended help.","","!")
- D PAUSE
- Q
- HELP1 ; DISPLAY LIST MANAGER STANDARD HELP SCREEN.
- Q
- ;
- PAUSE N DIR,DIRUT,DUOUT,DTOUT
- S DIR("A")="Enter RETURN to continue"
- S DIR(0)="E"
- D ^DIR
- Q
- ;
- EXIT ; -- exit code
- D CLEAN^VALM10
- Q
- ;
- NOTHING ; Come here if there are no transaction records to report.
- D EN^DDIOL("There are no records to report on at this time.","","!!?5")
- G PAUSE
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCOER 6401 printed Jan 18, 2025@03:13:05 Page 2
- PRCOER ;WISC/DJM-EDI REPORTS USING LIST MANAGER ; [10/20/98 11:58am]
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 ;
- EN ; -- main entry point for PRCO EDI REPORTS
- +1 ; First lets see if there is anything to report. If not - exit.
- +2 if $GET(PRCOFLG)=-1
- QUIT
- +3 NEW LIST,LIST1,LIST2,PO,PRCO
- +4 SET LIST=""
- +5 SET LIST=$ORDER(^PRC(443.75,"AC",LIST))
- +6 SET LIST1=""
- +7 SET LIST1=$ORDER(^PRC(443.75,"AF",LIST1))
- +8 SET LIST2=""
- +9 SET LIST2=$ORDER(^PRC(443.75,"AO",LIST2))
- +10 IF LIST=""
- IF LIST1=""
- IF LIST2=""
- GOTO NOTHING
- +11 NEW X
- +12 IF '$DATA(IOF)!('$GET(IOST(0)))
- SET IOP="HOME"
- DO ^%ZIS
- KILL IOP
- +13 SET X="IORVON;IORVOFF"
- DO ENDR^%ZISS
- +14 SET PRCO("RV1")=$GET(IORVON)
- +15 SET PRCO("RV0")=$GET(IORVOFF)
- +16 SET PRCO("XY")="N DX,DY S (DX,DY)=0 "_$GET(^%ZOSF("XY"))
- +17 DO EN^VALM("PRCO EDI REPORTS")
- +18 QUIT
- +19 ;
- HDR ; -- header code
- +1 SET VALMHDR(1)="EDI Transactions from IFCAP Reports"
- +2 IF SENDER>0
- Begin DoDot:1
- +3 SET NAME=$PIECE($GET(^VA(200,SENDER,0)),U)
- +4 SET VALMHDR(1)=VALMHDR(1)_" Sender is "_NAME
- +5 QUIT
- End DoDot:1
- +6 QUIT
- +7 ;
- INIT ; -- init variables and list array
- +1 NEW COUNT,DATE,LINENO,LIST,LIST0,LIST1,LIST2,ERROR,REJECT,RFQ,TXT,TYPE,VENDOR,VENDOR1
- +2 KILL ^PRC(443.75,"PRCOER",$JOB)
- +3 SET LIST=""
- +4 SET LIST=$ORDER(^PRC(443.75,"AC",LIST))
- +5 SET LIST1=""
- +6 SET LIST1=$ORDER(^PRC(443.75,"AF",LIST1))
- +7 SET LIST2=""
- +8 SET LIST2=$ORDER(^PRC(443.75,"AO",LIST2))
- +9 IF LIST=""
- IF LIST1=""
- IF LIST2=""
- GOTO NOTHING
- +10 DO CLEAN^VALM10
- +11 SET COUNT=0
- +12 SET LINENO=0
- +13 if SENDER>0
- GOTO INIT0
- +14 ;
- +15 ; First list all PROGRESS LEVEL 3 records.
- +16 ;
- +17 SET LIST=""
- +18 FOR
- SET LIST=$ORDER(^PRC(443.75,"AM",3,LIST))
- if LIST=""
- QUIT
- Begin DoDot:1
- +19 SET LIST0=""
- +20 FOR
- SET LIST0=$ORDER(^PRC(443.75,"AM",3,LIST,LIST0),-1)
- if LIST0=""
- QUIT
- Begin DoDot:2
- +21 SET LIST1=""
- +22 FOR
- SET LIST1=$ORDER(^PRC(443.75,"AM",3,LIST,LIST0,LIST1))
- if LIST1=""
- QUIT
- Begin DoDot:3
- +23 SET LIST2=$GET(^PRC(443.75,LIST1,0))
- +24 if LIST2=""
- QUIT
- +25 DO INIT1
- +26 QUIT
- End DoDot:3
- +27 QUIT
- End DoDot:2
- +28 QUIT
- End DoDot:1
- +29 ;
- +30 ; Next list all PROGRESS LEVEL 2 records.
- +31 ;
- +32 SET LIST=""
- +33 FOR
- SET LIST=$ORDER(^PRC(443.75,"AL",2,LIST))
- if LIST=""
- QUIT
- Begin DoDot:1
- +34 SET LIST0=""
- +35 FOR
- SET LIST0=$ORDER(^PRC(443.75,"AL",2,LIST,LIST0),-1)
- if LIST0=""
- QUIT
- Begin DoDot:2
- +36 SET LIST1=""
- +37 FOR
- SET LIST1=$ORDER(^PRC(443.75,"AL",2,LIST,LIST0,LIST1))
- if LIST1=""
- QUIT
- Begin DoDot:3
- +38 SET LIST2=$GET(^PRC(443.75,LIST1,0))
- +39 if LIST2=""
- QUIT
- +40 DO INIT1
- +41 QUIT
- End DoDot:3
- +42 QUIT
- End DoDot:2
- +43 QUIT
- End DoDot:1
- +44 ;
- +45 ; Last list all PROGRESS LEVEL 1 records.
- +46 ;
- +47 SET LIST=""
- +48 FOR
- SET LIST=$ORDER(^PRC(443.75,"AJ",1,LIST))
- if LIST=""
- QUIT
- Begin DoDot:1
- +49 SET LIST0=""
- +50 FOR
- SET LIST0=$ORDER(^PRC(443.75,"AJ",1,LIST,LIST0),-1)
- if LIST0=""
- QUIT
- Begin DoDot:2
- +51 SET LIST1=""
- +52 FOR
- SET LIST1=$ORDER(^PRC(443.75,"AJ",1,LIST,LIST0,LIST1))
- if LIST1=""
- QUIT
- Begin DoDot:3
- +53 SET LIST2=$GET(^PRC(443.75,LIST1,0))
- +54 if LIST2=""
- QUIT
- +55 DO INIT1
- +56 QUIT
- End DoDot:3
- +57 QUIT
- End DoDot:2
- +58 QUIT
- End DoDot:1
- +59 ;
- +60 ; Now lets show the list to the users.
- +61 ;
- +62 SET VALMCNT=COUNT
- +63 QUIT
- +64 ;
- INIT0 ; Come here if the user selected one sender to view.
- +1 ;
- +2 ; First list all PROGRESS LEVEL 3 records for SENDER.
- +3 ;
- +4 SET LIST=""
- +5 FOR
- SET LIST=$ORDER(^PRC(443.75,"AM1",3,SENDER,LIST))
- if LIST=""
- QUIT
- Begin DoDot:1
- +6 SET LIST0=""
- +7 FOR
- SET LIST0=$ORDER(^PRC(443.75,"AM1",3,SENDER,LIST,LIST0),-1)
- if LIST0=""
- QUIT
- Begin DoDot:2
- +8 SET LIST1=""
- +9 FOR
- SET LIST1=$ORDER(^PRC(443.75,"AM1",3,SENDER,LIST,LIST0,LIST1))
- if LIST1=""
- QUIT
- Begin DoDot:3
- +10 SET LIST2=$GET(^PRC(443.75,LIST1,0))
- +11 if LIST2=""
- QUIT
- +12 DO INIT1
- +13 QUIT
- End DoDot:3
- +14 QUIT
- End DoDot:2
- +15 QUIT
- End DoDot:1
- +16 ;
- +17 ; Next list all PROGRESS LEVEL 2 records for SENDER.
- +18 ;
- +19 SET LIST=""
- +20 FOR
- SET LIST=$ORDER(^PRC(443.75,"AL1",2,SENDER,LIST))
- if LIST=""
- QUIT
- Begin DoDot:1
- +21 SET LIST0=""
- +22 FOR
- SET LIST0=$ORDER(^PRC(443.75,"AL1",2,SENDER,LIST,LIST0),-1)
- if LIST0=""
- QUIT
- Begin DoDot:2
- +23 SET LIST1=""
- +24 FOR
- SET LIST1=$ORDER(^PRC(443.75,"AL1",2,SENDER,LIST,LIST0,LIST1))
- if LIST1=""
- QUIT
- Begin DoDot:3
- +25 SET LIST2=$GET(^PRC(443.75,LIST1,0))
- +26 if LIST2=""
- QUIT
- +27 DO INIT1
- +28 QUIT
- End DoDot:3
- +29 QUIT
- End DoDot:2
- +30 QUIT
- End DoDot:1
- +31 ;
- +32 ; Last list all PROGRESS LEVEL 1 records for SENDER.
- +33 ;
- +34 SET LIST=""
- +35 FOR
- SET LIST=$ORDER(^PRC(443.75,"AJ1",1,SENDER,LIST))
- if LIST=""
- QUIT
- Begin DoDot:1
- +36 SET LIST0=""
- +37 FOR
- SET LIST0=$ORDER(^PRC(443.75,"AJ1",1,SENDER,LIST,LIST0),-1)
- if LIST0=""
- QUIT
- Begin DoDot:2
- +38 SET LIST1=""
- +39 FOR
- SET LIST1=$ORDER(^PRC(443.75,"AJ1",1,SENDER,LIST,LIST0,LIST1))
- if LIST1=""
- QUIT
- Begin DoDot:3
- +40 SET LIST2=$GET(^PRC(443.75,LIST1,0))
- +41 if LIST2=""
- QUIT
- +42 DO INIT1
- +43 QUIT
- End DoDot:3
- +44 QUIT
- End DoDot:2
- +45 QUIT
- End DoDot:1
- +46 ;
- +47 ; Now lets show the list to the users.
- +48 ;
- +49 SET VALMCNT=COUNT
- +50 QUIT
- +51 ;
- INIT1 ; ENTER DATA FROM THE RECORD CHOOSEN.
- +1 ;
- +2 SET PO=$PIECE(LIST2,U,2)
- +3 SET TXT=+$PIECE(LIST2,U,3)
- +4 SET RFQ=+$PIECE(LIST2,U,10)
- +5 SET RFQ=$SELECT(RFQ=0:"O",1:"C")
- +6 SET TYPE=$PIECE(LIST2,U,4)
- +7 SET TXT=$SELECT(TYPE="TXT":TXT,TYPE="RFQ":RFQ,1:"")
- +8 SET VENDOR=$PIECE(LIST2,U,6)
- +9 SET DATE=$PIECE($PIECE(LIST2,U,7),".",1)
- +10 ;
- +11 IF TYPE="PHA"
- Begin DoDot:1
- +12 IF '$DATA(^PRC(440,"AG",VENDOR))
- SET VENDOR="Not Found"
- QUIT
- +13 SET VENDOR=$ORDER(^PRC(440,"AG",VENDOR,""))
- +14 SET VENDOR=$EXTRACT($PIECE($GET(^PRC(440,VENDOR,0)),U),1,30)
- +15 IF VENDOR']""
- SET VENDOR="Not Found"
- +16 QUIT
- End DoDot:1
- +17 ;
- +18 IF TYPE'="PHA"
- Begin DoDot:1
- +19 IF VENDOR="PUBLIC"
- QUIT
- +20 if $EXTRACT(VENDOR,1,3)'="DUN"
- SET VENDOR="DUN"_VENDOR
- +21 SET VENDOR1=$ORDER(^PRC(440,"DB",VENDOR,""))
- +22 IF VENDOR1>0
- SET VENDOR=$EXTRACT($PIECE($GET(^PRC(440,VENDOR1,0)),U),1,30)
- QUIT
- +23 SET VENDOR1=$ORDER(^PRC(444.1,"DB",VENDOR,""))
- +24 IF VENDOR1>0
- SET VENDOR=$EXTRACT($PIECE($GET(^PRC(444.1,VENDOR1,0)),U),1,30)
- QUIT
- +25 IF VENDOR']""
- SET VENDOR="Not Found"
- +26 QUIT
- End DoDot:1
- +27 ;
- +28 SET LIST2=$GET(^PRC(443.75,LIST1,1))
- +29 SET REJECT=$PIECE(LIST2,U,7)
- +30 SET ERROR=$PIECE(LIST2,U,12)
- +31 if $PIECE(LIST2,U,1)]""
- SET TYPE=$PIECE(LIST2,U,1)
- +32 if $PIECE(LIST2,U,15)]""
- SET TYPE=$PIECE(LIST2,U,15)
- +33 ;
- +34 ; IN THE NEXT LINE THE $S DEFAULT - THE 1:PART AT THE END- WILL BE
- +35 ; 'POA' IN THE TYPE VARIABLE.
- +36 ;
- +37 SET DATE=$SELECT(",PHA,RFQ,TXT,"[TYPE:DATE,",ACT,PRJ,"[TYPE:$PIECE($PIECE(LIST2,U,2),".",1),1:$PIECE($PIECE(LIST2,U,16),"."))
- +38 SET DATE=+$EXTRACT(DATE,4,5)_"/"_+$EXTRACT(DATE,6,7)_"/"_(+$EXTRACT(DATE,1,3)+1700)
- +39 SET COUNT=COUNT+1
- +40 SET X=$$SETFLD^VALM1(COUNT,"","NUMBER")
- +41 SET X=$$SETFLD^VALM1(PO,X,"PO")
- +42 SET X=$$SETFLD^VALM1(TXT,X,"TXT/RFQ")
- +43 SET X=$$SETFLD^VALM1(TYPE,X,"TYPE")
- +44 SET X=$$SETFLD^VALM1(VENDOR,X,"VENDOR")
- +45 SET X=$$SETFLD^VALM1(REJECT,X,"REJECT")
- +46 SET X=$$SETFLD^VALM1(ERROR,X,"ERROR")
- +47 SET X=$$SETFLD^VALM1(DATE,X,"DATE")
- +48 SET LINENO=LINENO+1
- +49 DO SET^VALM10(COUNT,X,LINENO)
- +50 SET ^PRC(443.75,"PRCOER",$JOB,LINENO)=COUNT_"^"_LIST1
- +51 QUIT
- +52 ;
- HELP ; -- help code
- +1 IF X["??"
- GOTO HELP1
- +2 ;
- +3 DO EN^DDIOL("Select one of the valid actions above, or enter '??' for extended help.","","!")
- +4 DO PAUSE
- +5 QUIT
- HELP1 ; DISPLAY LIST MANAGER STANDARD HELP SCREEN.
- +1 QUIT
- +2 ;
- PAUSE NEW DIR,DIRUT,DUOUT,DTOUT
- +1 SET DIR("A")="Enter RETURN to continue"
- +2 SET DIR(0)="E"
- +3 DO ^DIR
- +4 QUIT
- +5 ;
- EXIT ; -- exit code
- +1 DO CLEAN^VALM10
- +2 QUIT
- +3 ;
- NOTHING ; Come here if there are no transaction records to report.
- +1 DO EN^DDIOL("There are no records to report on at this time.","","!!?5")
- +2 GOTO PAUSE