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 Nov 22, 2024@17:21:59 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
