- MCESLIST ;WISC/DCB-This routine will list reports by release status ;5/2/96 09:58
- ;;2.3;Medicine;;09/13/1996
- START ;
- N MCAR,MCARCODE,MCARDE,MCARGDT2,MCARGNAM,MCARGNUM,MCARP,MCBP,MCBS
- N MCEPROC,MCESKEY,MCESON,MCESS,MCESSEC,MCFILE,MCFILE1,MCOUNT
- N MCPATFLD,MCPOSTP,MCPRO,MCPRTRTN,MCROUT,MCSUP,NOPT,MCOPT,PATN,LOC
- N PROC,OPTION,DIR,Y,DTOUT,DIRUT,DIROUT,DUOUT,DHIT,DIOEND,DIROUR
- S OPTION=$P(XQY0,U)
- S MCPRO=$P(OPTION,"MCESSTATUS",2)
- K ^TMP($J,"MC","STATUS")
- D MCPPROC^MCARP1
- I 'MCESON S MCESSEC=$D(^XUSEC(MCESKEY,DUZ)) W !,"Release Control/Elec Signature is turn off"
- I 'MCESSEC W !,"You don't have the required key [",MCESKEY,"]" Q
- D ASK
- I '$D(OUT) D PRINT
- K ^TMP($J,"MC","STATUS"),OUT Q
- ASK ;SELECT STATUS
- S DIR(0)="S^1:Release;2:Draft;3:Both"
- S DIR("B")="Both"
- S DIR("A")="Which type of listing do you want see?"
- S DIR("?",1)="1 Release Status - will only release information"
- S DIR("?",2)="2 Draft Status - will only show reports that are in draft status"
- S DIR("?",3)="3 Both - will show all reports"
- S DIR("?")="Help"
- D ^DIR I $D(DTOUT)!$D(DIRUT)!$D(DUOUT)!$D(DIROUR) S OUT="" Q
- S MCOPT=Y
- Q
- TEST(REC,OPT,MCFILE) ;Screens out information
- N STATUS,TEST
- S STATUS=$P($G(^MCAR(MCFILE,REC,"ES")),U,7) S:STATUS="" STATUS="D"
- S TEST=OPT+$S(STATUS["D":1,1:0)
- Q $S(STATUS="S":0,OPT=3:1,TEST=1:1,TEST=3:1,1:0)
- STAT ;TOTALS OF STATUS
- N STATUS
- S STATUS=$P($G(^MCAR(MCFILE,D0,"ES")),U,7) S:STATUS="" STATUS="NS"
- S ^TMP($J,"MC","STATUS",STATUS)=$G(^TMP($J,"MC","STATUS",STATUS))+1
- Q
- PRINT ; Sets up variables for the DIP call
- N DIS,DHD,DA,DIASKHD,PG,L
- S L=""
- S DIC=^DIC(MCFILE,0,"GL")
- S FLDS=".01;""Date/Time"";C1,"_MCPATFLD_";""Patient"";C22;L30,"""";""Status"";C53,1506;""Status"";C53;W;X",BY=".01"
- S DIS(0)="I $$TEST^MCESLIST(D0,MCOPT,MCFILE)"
- S:MCFILE=699 DIS(1)="I $D(^MCAR(697.2,""D"",MCARCODE,+$P(^MCAR(699,+D0,0),U,12)))"
- S DHD=$S(MCOPT=1:"Release Status Report",MCOPT=2:"Draft Status Report",1:"Status Report"),MCDHD=DHD
- S DIOEND="D STATUS^MCESLIST"
- S DHIT="D STAT^MCESLIST"
- D EN1^DIP
- Q
- STATUS ; Prints a status count
- N LOOP,STATUS,INFO,COUNT,TOTAL,LINE,DIR,Y,%
- S LINE="" S $P(LINE,"-",80)=""
- I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR I $D(DTOUT)!$D(DIRUT)!$D(DUOUT)!$D(DIROUR) S OUT="" Q
- W @IOF,MCDHD_" statistics"
- D NOW^%DTC S Y=% D DD^%DT W ?46,$P(Y,"@")_" "_$P(Y,"@",2)
- W !,LINE,!!
- S STATUS=$S(MCOPT=1:"R",MCOPT=2:"D",1:"")
- F LOOP="D","PD","RV","ROV","RNV","SRV","SROV","NS" D
- .I LOOP="NS"&(STATUS="D") S STATUS=""
- .I STATUS=""!(LOOP[STATUS) D
- ..S COUNT=+$G(^TMP($J,"MC","STATUS",LOOP))
- ..S TOTAL=$G(TOTAL)+COUNT
- ..I LOOP'="NS" S INFO=$$STATUS^MCESEDT(MCFILE,LOOP)
- ..E S INFO="NO STATUS/DRAFT"
- ..S INFO=$J(INFO,45)_": "
- ..W !,INFO,?50,$J($FN(COUNT,",",0),10)
- W !,?50,$E(LINE,1,10),!,?50,$J($FN(TOTAL,",",0),10),!!
- I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR
- W @IOF
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCESLIST 2923 printed Jan 18, 2025@03:16:19 Page 2
- MCESLIST ;WISC/DCB-This routine will list reports by release status ;5/2/96 09:58
- +1 ;;2.3;Medicine;;09/13/1996
- START ;
- +1 NEW MCAR,MCARCODE,MCARDE,MCARGDT2,MCARGNAM,MCARGNUM,MCARP,MCBP,MCBS
- +2 NEW MCEPROC,MCESKEY,MCESON,MCESS,MCESSEC,MCFILE,MCFILE1,MCOUNT
- +3 NEW MCPATFLD,MCPOSTP,MCPRO,MCPRTRTN,MCROUT,MCSUP,NOPT,MCOPT,PATN,LOC
- +4 NEW PROC,OPTION,DIR,Y,DTOUT,DIRUT,DIROUT,DUOUT,DHIT,DIOEND,DIROUR
- +5 SET OPTION=$PIECE(XQY0,U)
- +6 SET MCPRO=$PIECE(OPTION,"MCESSTATUS",2)
- +7 KILL ^TMP($JOB,"MC","STATUS")
- +8 DO MCPPROC^MCARP1
- +9 IF 'MCESON
- SET MCESSEC=$DATA(^XUSEC(MCESKEY,DUZ))
- WRITE !,"Release Control/Elec Signature is turn off"
- +10 IF 'MCESSEC
- WRITE !,"You don't have the required key [",MCESKEY,"]"
- QUIT
- +11 DO ASK
- +12 IF '$DATA(OUT)
- DO PRINT
- +13 KILL ^TMP($JOB,"MC","STATUS"),OUT
- QUIT
- ASK ;SELECT STATUS
- +1 SET DIR(0)="S^1:Release;2:Draft;3:Both"
- +2 SET DIR("B")="Both"
- +3 SET DIR("A")="Which type of listing do you want see?"
- +4 SET DIR("?",1)="1 Release Status - will only release information"
- +5 SET DIR("?",2)="2 Draft Status - will only show reports that are in draft status"
- +6 SET DIR("?",3)="3 Both - will show all reports"
- +7 SET DIR("?")="Help"
- +8 DO ^DIR
- IF $DATA(DTOUT)!$DATA(DIRUT)!$DATA(DUOUT)!$DATA(DIROUR)
- SET OUT=""
- QUIT
- +9 SET MCOPT=Y
- +10 QUIT
- TEST(REC,OPT,MCFILE) ;Screens out information
- +1 NEW STATUS,TEST
- +2 SET STATUS=$PIECE($GET(^MCAR(MCFILE,REC,"ES")),U,7)
- if STATUS=""
- SET STATUS="D"
- +3 SET TEST=OPT+$SELECT(STATUS["D":1,1:0)
- +4 QUIT $SELECT(STATUS="S":0,OPT=3:1,TEST=1:1,TEST=3:1,1:0)
- STAT ;TOTALS OF STATUS
- +1 NEW STATUS
- +2 SET STATUS=$PIECE($GET(^MCAR(MCFILE,D0,"ES")),U,7)
- if STATUS=""
- SET STATUS="NS"
- +3 SET ^TMP($JOB,"MC","STATUS",STATUS)=$GET(^TMP($JOB,"MC","STATUS",STATUS))+1
- +4 QUIT
- PRINT ; Sets up variables for the DIP call
- +1 NEW DIS,DHD,DA,DIASKHD,PG,L
- +2 SET L=""
- +3 SET DIC=^DIC(MCFILE,0,"GL")
- +4 SET FLDS=".01;""Date/Time"";C1,"_MCPATFLD_";""Patient"";C22;L30,"""";""Status"";C53,1506;""Status"";C53;W;X"
- SET BY=".01"
- +5 SET DIS(0)="I $$TEST^MCESLIST(D0,MCOPT,MCFILE)"
- +6 if MCFILE=699
- SET DIS(1)="I $D(^MCAR(697.2,""D"",MCARCODE,+$P(^MCAR(699,+D0,0),U,12)))"
- +7 SET DHD=$SELECT(MCOPT=1:"Release Status Report",MCOPT=2:"Draft Status Report",1:"Status Report")
- SET MCDHD=DHD
- +8 SET DIOEND="D STATUS^MCESLIST"
- +9 SET DHIT="D STAT^MCESLIST"
- +10 DO EN1^DIP
- +11 QUIT
- STATUS ; Prints a status count
- +1 NEW LOOP,STATUS,INFO,COUNT,TOTAL,LINE,DIR,Y,%
- +2 SET LINE=""
- SET $PIECE(LINE,"-",80)=""
- +3 IF $EXTRACT(IOST,1,2)="C-"
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- IF $DATA(DTOUT)!$DATA(DIRUT)!$DATA(DUOUT)!$DATA(DIROUR)
- SET OUT=""
- QUIT
- +4 WRITE @IOF,MCDHD_" statistics"
- +5 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- WRITE ?46,$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)
- +6 WRITE !,LINE,!!
- +7 SET STATUS=$SELECT(MCOPT=1:"R",MCOPT=2:"D",1:"")
- +8 FOR LOOP="D","PD","RV","ROV","RNV","SRV","SROV","NS"
- Begin DoDot:1
- +9 IF LOOP="NS"&(STATUS="D")
- SET STATUS=""
- +10 IF STATUS=""!(LOOP[STATUS)
- Begin DoDot:2
- +11 SET COUNT=+$GET(^TMP($JOB,"MC","STATUS",LOOP))
- +12 SET TOTAL=$GET(TOTAL)+COUNT
- +13 IF LOOP'="NS"
- SET INFO=$$STATUS^MCESEDT(MCFILE,LOOP)
- +14 IF '$TEST
- SET INFO="NO STATUS/DRAFT"
- +15 SET INFO=$JUSTIFY(INFO,45)_": "
- +16 WRITE !,INFO,?50,$JUSTIFY($FNUMBER(COUNT,",",0),10)
- End DoDot:2
- End DoDot:1
- +17 WRITE !,?50,$EXTRACT(LINE,1,10),!,?50,$JUSTIFY($FNUMBER(TOTAL,",",0),10),!!
- +18 IF $EXTRACT(IOST,1,2)="C-"
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- +19 WRITE @IOF
- +20 QUIT