ECXFMTR ;ORL/NJW - MAS MOVEMENT TYPE REPORT ; Apr 08, 2024@15:13:43
;;3.0;DSS EXTRACTS;**190**;Dec 22, 1997;Build 36
;
;
;Loop through 405.2, pull fields and display
;Current fields
; 405.2/.001 - Entry Number
; 405.2/.01 - Name
; 405.2/.02 - Transaction Type
; 405.1/.04 - Active
DSSFILE ; Pull the data from the files
N CODE,CNT,DESC,ECXPORT,ENTRY,FIELD,FFILE,INDEX,LIST,MFILE,NAME,TFILE,TXN
;
D CLEANUP
S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1 I $G(ECXPORT) D Q
. K ^TMP($J,"ECXPORT")
. S ^TMP($J,"ECXPORT",0)="IEN^NAME^TRANSACTION TYPE",CNT=0
. D BUILD
. D PRINT
. D EXPDISP^ECXUTL1
. D CLEANUP
. K ^TMP($J,"ECXPORT")
;
;Queue Report
N X,ZTDESC,ZTIO,ZTSAVE
F X="SDATE","EDATE","ECRUN","STOP" S ZTSAVE(X)=""
S ZTIO=""
S ZTDESC="DSS MAS Movement Type List Report"
D EN^XUTMDEVQ("EN1^ECXFMTR",ZTDESC,.ZTSAVE)
Q
;
EN1 ; Report proper
D BUILD
;
D PRINT
;
D CLEANUP
Q
;
CLEANUP ; Cleanup TMP
K ^TMP($J,"FACILITY LIST")
K ^TMP($J,"MAS MOVEMENT TYPE")
Q
;
ACTIVE ;Build Active List Linking 405.1 and 405.2
;S ^TMP($J,"MAS MOVEMENT TYPE",MAS)=ACTIVE
;
N ACTIVE,MAS
;
S INDEX=""
F S INDEX=$O(^DG(FFILE,"B",INDEX)) Q:INDEX="" D
. S ENTRY=""
. F S ENTRY=$O(^DG(FFILE,"B",INDEX,ENTRY)) Q:ENTRY="" D
. . ;Field - Active
. . S FIELD=.04
. . S ACTIVE=$$GET1^DIQ(FFILE,ENTRY,FIELD)
. . ;
. . ;Field - MAS Movement Type - Lookup to 405.2
. . S FIELD=.03
. . S MAS=$$GET1^DIQ(FFILE,ENTRY,FIELD,"I") ;Get MAS internal
. . ;
. . I MAS'="" S ^TMP($J,"MAS MOVEMENT TYPE",MAS)=ACTIVE
Q
BUILD ; Build Report
S FFILE=405.1 ;FACILITY MOVEMENT TYPE
S MFILE=405.2 ;MAS MOVEMENT TYPE
S TFILE=405.3 ;MAS MOVEMENT TRANSACTION TYPE
;
;D ACTIVE
;
S INDEX=""
F S INDEX=$O(^DG(MFILE,"B",INDEX)) Q:INDEX="" D
. S ENTRY=""
. F S ENTRY=$O(^DG(MFILE,"B",INDEX,ENTRY)) Q:ENTRY="" D
. . ;Field - ENTRY NUMBER
. . S FIELD=.001
. . S CODE=$$GET1^DIQ(MFILE,ENTRY,FIELD)
. . ;
. . ;Field - Name
. . S FIELD=.01
. . S NAME=$$GET1^DIQ(MFILE,ENTRY,FIELD)
. . ;
. . ;Field - Transaction Type - Lookup to 405.3 = field .01 (30)
. . ;DA is the ENTRY in 405.3
. . S FIELD=.02
. . S TXN=$$GET1^DIQ(MFILE,ENTRY,FIELD,"I") ;Get TXN internal
. . S FIELD=.01
. . I TXN'="" S TXN=$$GET1^DIQ(TFILE,TXN,FIELD) ;TXN File lookup
. . ;
. . I CODE'="" S ^TMP($J,"FACILITY LIST",CODE,ENTRY)=NAME_"^"_TXN
Q
;
PRINT ; Loop throught the list and display
N CODE,DATA,ECXTMP,ENTRY,I,LN,OK,PAGE
S PAGE=1
S OK=1
S $P(LN,"-",81)="" ;80 Character Line --- Can change to IOM
;
D HEADER
I '$G(ECXPORT),'$D(^TMP($J,"FACILITY LIST")) W !!,"No Movement Types to display" Q
;
;Loop on TMP for entries, handle paging, calls to HEADER and CONTINUE
S CODE=""
F S CODE=$O(^TMP($J,"FACILITY LIST",CODE)) Q:CODE="" D Q:'OK
. S ENTRY=""
. F S ENTRY=$O(^TMP($J,"FACILITY LIST",CODE,ENTRY)) Q:ENTRY="" D Q:'OK
. . I $G(ECXPORT) D Q
. . . S CNT=$G(CNT)+1,^TMP($J,"ECXPORT",CNT)=CODE_U_^TMP($J,"FACILITY LIST",CODE,ENTRY)
. . I ($Y+4)>$G(IOSL) D PAUSE I OK D HEADER
. . I 'OK Q
. . K ECXTMP
. . S ECXTMP=0
. . S DATA=^TMP($J,"FACILITY LIST",CODE,ENTRY)
. . W !,CODE,?7,$P(DATA,"^"),?49,$P(DATA,"^",2)
;
;I 'ECXPORT,OK D PAUSE
;
Q
;
Q:$G(ECXPORT) ; Don't print header if export format
W @IOF
W "MAS Movement Type List",?35,$$FMTE^XLFDT($$NOW^XLFDT),?72,"Page ",PAGE
W !,"IEN",?7,"NAME",?49,"TRANSACTION TYPE"
W !,LN
S PAGE=PAGE+1
Q
;
PAUSE ; Ask if the user wants to continue [or quit (Set OK=0)]
N DIR,X,Y
W !
S DIR(0)="E" D ^DIR K DIR I 'Y S OK=0 Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXFMTR 3699 printed Dec 13, 2024@01:52:40 Page 2
ECXFMTR ;ORL/NJW - MAS MOVEMENT TYPE REPORT ; Apr 08, 2024@15:13:43
+1 ;;3.0;DSS EXTRACTS;**190**;Dec 22, 1997;Build 36
+2 ;
+3 ;
+4 ;Loop through 405.2, pull fields and display
+5 ;Current fields
+6 ; 405.2/.001 - Entry Number
+7 ; 405.2/.01 - Name
+8 ; 405.2/.02 - Transaction Type
+9 ; 405.1/.04 - Active
DSSFILE ; Pull the data from the files
+1 NEW CODE,CNT,DESC,ECXPORT,ENTRY,FIELD,FFILE,INDEX,LIST,MFILE,NAME,TFILE,TXN
+2 ;
+3 DO CLEANUP
+4 SET ECXPORT=$$EXPORT^ECXUTL1
if ECXPORT=-1
QUIT
IF $GET(ECXPORT)
Begin DoDot:1
+5 KILL ^TMP($JOB,"ECXPORT")
+6 SET ^TMP($JOB,"ECXPORT",0)="IEN^NAME^TRANSACTION TYPE"
SET CNT=0
+7 DO BUILD
+8 DO PRINT
+9 DO EXPDISP^ECXUTL1
+10 DO CLEANUP
+11 KILL ^TMP($JOB,"ECXPORT")
End DoDot:1
QUIT
+12 ;
+13 ;Queue Report
+14 NEW X,ZTDESC,ZTIO,ZTSAVE
+15 FOR X="SDATE","EDATE","ECRUN","STOP"
SET ZTSAVE(X)=""
+16 SET ZTIO=""
+17 SET ZTDESC="DSS MAS Movement Type List Report"
+18 DO EN^XUTMDEVQ("EN1^ECXFMTR",ZTDESC,.ZTSAVE)
+19 QUIT
+20 ;
EN1 ; Report proper
+1 DO BUILD
+2 ;
+3 DO PRINT
+4 ;
+5 DO CLEANUP
+6 QUIT
+7 ;
CLEANUP ; Cleanup TMP
+1 KILL ^TMP($JOB,"FACILITY LIST")
+2 KILL ^TMP($JOB,"MAS MOVEMENT TYPE")
+3 QUIT
+4 ;
ACTIVE ;Build Active List Linking 405.1 and 405.2
+1 ;S ^TMP($J,"MAS MOVEMENT TYPE",MAS)=ACTIVE
+2 ;
+3 NEW ACTIVE,MAS
+4 ;
+5 SET INDEX=""
+6 FOR
SET INDEX=$ORDER(^DG(FFILE,"B",INDEX))
if INDEX=""
QUIT
Begin DoDot:1
+7 SET ENTRY=""
+8 FOR
SET ENTRY=$ORDER(^DG(FFILE,"B",INDEX,ENTRY))
if ENTRY=""
QUIT
Begin DoDot:2
+9 ;Field - Active
+10 SET FIELD=.04
+11 SET ACTIVE=$$GET1^DIQ(FFILE,ENTRY,FIELD)
+12 ;
+13 ;Field - MAS Movement Type - Lookup to 405.2
+14 SET FIELD=.03
+15 ;Get MAS internal
SET MAS=$$GET1^DIQ(FFILE,ENTRY,FIELD,"I")
+16 ;
+17 IF MAS'=""
SET ^TMP($JOB,"MAS MOVEMENT TYPE",MAS)=ACTIVE
End DoDot:2
End DoDot:1
+18 QUIT
BUILD ; Build Report
+1 ;FACILITY MOVEMENT TYPE
SET FFILE=405.1
+2 ;MAS MOVEMENT TYPE
SET MFILE=405.2
+3 ;MAS MOVEMENT TRANSACTION TYPE
SET TFILE=405.3
+4 ;
+5 ;D ACTIVE
+6 ;
+7 SET INDEX=""
+8 FOR
SET INDEX=$ORDER(^DG(MFILE,"B",INDEX))
if INDEX=""
QUIT
Begin DoDot:1
+9 SET ENTRY=""
+10 FOR
SET ENTRY=$ORDER(^DG(MFILE,"B",INDEX,ENTRY))
if ENTRY=""
QUIT
Begin DoDot:2
+11 ;Field - ENTRY NUMBER
+12 SET FIELD=.001
+13 SET CODE=$$GET1^DIQ(MFILE,ENTRY,FIELD)
+14 ;
+15 ;Field - Name
+16 SET FIELD=.01
+17 SET NAME=$$GET1^DIQ(MFILE,ENTRY,FIELD)
+18 ;
+19 ;Field - Transaction Type - Lookup to 405.3 = field .01 (30)
+20 ;DA is the ENTRY in 405.3
+21 SET FIELD=.02
+22 ;Get TXN internal
SET TXN=$$GET1^DIQ(MFILE,ENTRY,FIELD,"I")
+23 SET FIELD=.01
+24 ;TXN File lookup
IF TXN'=""
SET TXN=$$GET1^DIQ(TFILE,TXN,FIELD)
+25 ;
+26 IF CODE'=""
SET ^TMP($JOB,"FACILITY LIST",CODE,ENTRY)=NAME_"^"_TXN
End DoDot:2
End DoDot:1
+27 QUIT
+28 ;
PRINT ; Loop throught the list and display
+1 NEW CODE,DATA,ECXTMP,ENTRY,I,LN,OK,PAGE
+2 SET PAGE=1
+3 SET OK=1
+4 ;80 Character Line --- Can change to IOM
SET $PIECE(LN,"-",81)=""
+5 ;
+6 DO HEADER
+7 IF '$GET(ECXPORT)
IF '$DATA(^TMP($JOB,"FACILITY LIST"))
WRITE !!,"No Movement Types to display"
QUIT
+8 ;
+9 ;Loop on TMP for entries, handle paging, calls to HEADER and CONTINUE
+10 SET CODE=""
+11 FOR
SET CODE=$ORDER(^TMP($JOB,"FACILITY LIST",CODE))
if CODE=""
QUIT
Begin DoDot:1
+12 SET ENTRY=""
+13 FOR
SET ENTRY=$ORDER(^TMP($JOB,"FACILITY LIST",CODE,ENTRY))
if ENTRY=""
QUIT
Begin DoDot:2
+14 IF $GET(ECXPORT)
Begin DoDot:3
+15 SET CNT=$GET(CNT)+1
SET ^TMP($JOB,"ECXPORT",CNT)=CODE_U_^TMP($JOB,"FACILITY LIST",CODE,ENTRY)
End DoDot:3
QUIT
+16 IF ($Y+4)>$GET(IOSL)
DO PAUSE
IF OK
DO HEADER
+17 IF 'OK
QUIT
+18 KILL ECXTMP
+19 SET ECXTMP=0
+20 SET DATA=^TMP($JOB,"FACILITY LIST",CODE,ENTRY)
+21 WRITE !,CODE,?7,$PIECE(DATA,"^"),?49,$PIECE(DATA,"^",2)
End DoDot:2
if 'OK
QUIT
End DoDot:1
if 'OK
QUIT
+22 ;
+23 ;I 'ECXPORT,OK D PAUSE
+24 ;
+25 QUIT
+26 ;
+1 ; Don't print header if export format
if $GET(ECXPORT)
QUIT
+2 WRITE @IOF
+3 WRITE "MAS Movement Type List",?35,$$FMTE^XLFDT($$NOW^XLFDT),?72,"Page ",PAGE
+4 WRITE !,"IEN",?7,"NAME",?49,"TRANSACTION TYPE"
+5 WRITE !,LN
+6 SET PAGE=PAGE+1
+7 QUIT
+8 ;
PAUSE ; Ask if the user wants to continue [or quit (Set OK=0)]
+1 NEW DIR,X,Y
+2 WRITE !
+3 SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET OK=0
QUIT
+4 QUIT
