ECXSCLD1 ;ALB/DAN <CONT> Enter, Print and Edit Entries in 728.44 ;4/4/19 15:52
;;3.0;DSS EXTRACTS;**132,136,144,149,154,161,166,174,184**;Dec 22, 1997;Build 124
;
HEAD ; header for worksheet 149 - moved from ECXSCLD due to size restraints.
D:PG SS Q:QFLG
N HEAD1 ;154
S HEAD1="WORKSHEET FOR DSS CLINIC STOPS" ;154
I (ECALL="D") S HEAD1=HEAD1_" (DUPLICATE CLINIC LIST)" ;154
S PG=PG+1 W:$Y!($E(IOST)="C") @IOF W !,HEAD1,@$S(ECALL="D":"?71",1:"?123"),"Page: ",PG ;161
W !,$S(ECDATE="":"(NEVER APPROVED)",1:"(last approved on "_ECDATE_")"),@$S(ECALL="D":"?59",1:"?112"),"Print Date:",$TR($$FMTE^XLFDT(DT,"2F")," ",0) ;144,161
I (ECALL'="D") D ;149
.W !
.W !,?1,"CLINIC",?33,"STOP",?42,"CREDIT",?52,"ACTION",?63,"CHAR4",?70,"MCA",?77,"C/N",?87,"DSS",?108,"NON-OR" ;154 CVW,161,166
.W ?124,"PROVIDER" ;184
.W !,?33,"CODE",?42,"STOP",?63,"CODE",?70,"LABOR",?87,"PRODUCT",?108,"DSS" ;161,166
.W ?124,"STATION" ;184
.W !,?42,"CODE",?70,"CODE",?87,"DEPARTMENT",?108,"IDENTIFIER" ;144,149 CVW,161
.W !,"( * - currently inactive)" ;154 CVW
.W !,LN
I (ECALL="D") D ;149
.W !
.W !,"CLINIC NAME",?32,"CLINIC",?44,"STOP",?50,"CRED",?55,"CHAR4",?61,"MCA",?67,"CLINIC",?76,"DIV" ;154,161,166 CVW
.W ?82,"PROVIDER" ;184
.W !,?32,"IEN",?44,"CODE",?50,"STOP",?55,"CODE",?61,"LABOR",?67,"APPT" ;154,161,166 CVW
.W ?82,"LOCATION" ;184
.W !,?50,"CODE",?61,"CODE",?67,"LENGTH" ;154,161,166 CVW
.W !,LN
Q
;
SS ;SCROLL STOPS 149 - moved from ECXSCLD due to size restraints.
N JJ,SS
W !,LN
;W !,"Key: + - new clinic; ! - updated since last review; * - currently inactiv
I $E(IOST)="C" S SS=21-$Y F JJ=1:1:SS W !
I $E(IOST)="C",PG>0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1 Q
Q
;
ERRCHK(CODE,TYPE,CLIEN1) ;check for problems 149 - moved from ECXSCLD due to size restraints.
;input
; code: stop code IEN in #40.7
; type: type (3=dss stop code, 4=dss credit stop code)
; clien: clinic IEN in #728.44
;output
; ecxerr: error msg
N XCODE,INACT,RTYPE,ERR,WRN
K ECXERR,WARNING
S ECXERR="",WARNING="",ERR=0
Q:'$G(CODE) -1 Q:'$G(CLIEN1) -1
Q:(TYPE="") -1 Q:((TYPE<3)&(TYPE>4)) -1
S XCODE=$P(^DIC(40.7,CODE,0),"^",2)
S TYPE=$S(TYPE=3:"DSS Stop Code",1:"DSS Credit Stop Code")
I TYPE="DSS Stop Code" D STOP^ECXSTOP(XCODE,TYPE,,,CODE)
I TYPE="DSS Credit Stop Code" D STOP^ECXSTOP(XCODE,TYPE,CLIEN1,,CODE)
I $G(ERR)>0,$D(ECXERR(1)) S ERR=$O(ECXERR(0)),ECXERR=ECXERR(ERR) Q ECXERR
E S ECXERR="" Q ECXERR
Q ECXERR
;
SHOWEM ; list clinics for worksheet 149 moved from ECXSCLD due to size.
I $Y+6>IOSL D HEAD Q:QFLG
N ECNON1P
S ECNON=$P(ECD,U,11),ECNON1P=$E(ECNON,1)
S ECNON1P=$S(ECNON1P="Y":"N",1:"C") ;if 'yes', then, 'n'on count clinic
S ECNON=ECNON1P_$E(ECNON,2,99)
W !!,ECSC ;161
W:$P(ECD,U,9)]"" "*" ;144
W ?33,$P(ECD,U,1),?42,$P(ECD,U,2),?55,$P(ECD,U,5)
;F J=1:1:5 W ?$P("28,35,44,50,62",",",J),$S($P(ECD,U,J):$P(ECD,U,J),J<3:"",1:"_____")
S ECN=$P($G(^ECX(728.441,+$P(ECD,U,7),0)),U) W ?63,$S(ECN]"":ECN,1:"____"),?70,$$GET1^DIQ(728.442,$P(ECD,U,13),.01),?78,ECNON,?87,$P(ECD,U,10),?108,$P(ECD,U,8) ;161
W ?124,$$GET1^DIQ(4,$P(ECD,U,14),99,"E") ;184
Q
ERRPRNT ;print errors
I $G(ERR)>0,$D(ECXERR) D
. W ! S I=0 F S I=$O(ECXERR(I)) Q:'I D
. . W !,"..",ECXERR(I)
I $G(WRN)>0,$D(WARNING) D
. W ! S I=0 F S I=$O(WARNING(I)) Q:'I D
. . W !,"..",WARNING(I)
Q
EDIT1 ;check input & update field #3; allow '@' deletion; allow bypass empty with no entry
;**NOTE THIS CODE IS NOT CURRENT as of patch 154, and it was moved here from ECXSCLD due
;to size constraints. The code was left as documentation of what was changed, and for potential
;re-instatement by the customer. Please note, there are calls that would need to be updated if used
;again from within this routine.
;N DIR ;136
;S OUT=0 F D Q:OUT
;.K DIC,DIR,ECXMSG,FDA,AMIS,X,Y
;.S STOP=$P(^ECX(728.44,CLIEN1,0),U,4)
;.S DIR(0)="FO^1:99",DIR("A")="DSS STOP CODE (3-digit code only)" I STOP]"" S DIR("B")=STOP
;.S DIR("?")="^S DIC=40.7,DIC(0)=""EMQZ"" D ^DIC"
;.D ^DIR
;.I X="@" D Q
;..S IENS=CLIEN1_",",FDA(728.44,IENS,3)=X D FILE^DIE("","FDA")
;..S OUT=1 W " deleted..."
;.I X="" S X=STOP K DIRUT S OUT=2 Q
;.S DIC("A")="DSS STOP CODE (3-digit code only): "
;.S DIC="^DIC(40.7,",DIC(0)="EMQZ"
;.S DIC("S")="I $P(^(0),U,3)=""""" D ^DIC
;.I X="@" D Q
;..S IENS=CLIEN1_",",FDA(728.44,IENS,3)=X D FILE^DIE("","FDA")
;..S OUT=2 W " deleted..."
;.I X="" K DIRUT S OUT=2 Q
;.I ($G(DIRUT)!$G(DUOUT)!$G(DTOUT)) S OUT=3 Q
;.I +X'=X W !,?5,"Invalid... try again." Q
;.I +Y'>0 Q
;.S AMIS=$P(^DIC(40.7,+Y,0),"^",2)
;.S CODE=+Y,ECXMSG=$$ERRCHK(CODE,3,CLIEN1)
;.I ECXMSG=-1 W !,?5,"Invalid... try again." Q
;.I $G(ECXMSG)]"" W !,?5,ECXMSG,! Q
;.S IENS=CLIEN1_",",FDA(728.44,IENS,3)=AMIS D FILE^DIE("U","FDA")
;.S OUT=1
;I ($G(DIRUT)!$G(DUOUT)!$G(DTOUT)) G ENDX
;check input & update field #4; allow '@' deletion; allow bypass empty with no entry
;S OUT=0 F D G:OUT=1 ENDCHK
;.K DIC,DIR,ECXMSG,FDA,AMIS,X,Y
;.S CSTOP=$P(^ECX(728.44,CLIEN1,0),U,5)
;.S DIR(0)="FO^1:99",DIR("A")="DSS CREDIT STOP CODE (3-digit code only)" I CSTOP]"" S DIR("B")=CSTOP
;.S DIR("?")="^S DIC=40.7,DIC(0)=""EMQZ"" D ^DIC"
;.D ^DIR
;.I X="@" D Q
;..S IENS=CLIEN1_",",FDA(728.44,IENS,4)=X D FILE^DIE("","FDA")
;..S OUT=1 W " deleted..."
;.I X="" S X=CSTOP K DIRUT S OUT=1 Q
;.S DIC("A")="DSS CREDIT STOP CODE (3-digit code only): "
;.S DIC("S")="I $P(^(0),U,3)=""""" D ^DIC
;.S DIC=40.7,DIC(0)="EMQZ" D ^DIC
;.I X="" K DIRUT S OUT=1 Q
;.I ($G(DIRUT)!$G(DUOUT)!$G(DTOUT)) S OUT=1 Q
;.I +X'=X W !,?5,"Invalid... try again." Q
;.I +Y'>0 Q
;.S AMIS=$P(^DIC(40.7,+Y,0),"^",2)
;.S CODE=+Y,ECXMSG=$$ERRCHK(CODE,4,CLIEN1)
;.I ECXMSG=-1 W !,?5,"Invalid... try again." Q
;.I $G(ECXMSG)]"" W !,?5,ECXMSG,! Q
;.S IENS=CLIEN1_",",FDA(728.44,IENS,4)=AMIS D FILE^DIE("U","FDA")
;.S OUT=1
;I ($G(DIRUT)!$G(DUOUT)!$G(DTOUT)) G ENDX
;K I,WARNING,DIC,DIE,DA,DR,DIR,DIRUT,DTOUT,DUOUT,X,Y,ERRCHK
;K CLIEN1,CODE,ECXMSG,IENS,STOP,CSTOP,AMIS,FDA,OUT,ERR,WRN,ECXERR
Q
EXPORT ;Export clinic review data to spreedsheet
N DIC,DIR,FLDS,BY,FR,L,DIOBEG,DIR,DIS,Y,DIRUT,POP,DUOUT,DTOUT,DIROUT,X,%ZIS,IOP,CCNT,ECXCLX,APPL,ECXMCA ;144,166
N STA6A ;184
W !!,"Select which clinics to include on the spreadsheet for exporting." ;144
S DIR(0)="SAO^A:ALL CLINICS;C:ACTIVE CLINICS;D:DUPLICATE CLINICS;I:INACTIVE CLINICS;U:UNREVIEWED CLINICS",DIR("?")="Enter letter associated with the group of clinics to include on the spreadsheet" ;149
S DIR("A",1)="Select (A)ll, a(C)tive, (D)uplicate, (I)nactive, " ;149
S DIR("A")="or (U)nreviewed clinics for export: "
D ^DIR K DIR I $D(DIRUT) Q ;144 Stop if no selection made
S ECALL=$E(Y)
I ECALL'="D" D
.W !!,"To ensure all data is captured during the export:" ;144
.;174 Update logging instructions
.;184 Update the width from 225 to 255 characters.
.W !!,"1. In reflections, change the row margin by clicking on one of the change margin",!," icons with a value of 255 or higher if you have them."
.W !," You may also set the margin manually by clicking on appearance, expanded",!," terminal settings (arrow in lower right corner), set up display settings."
.W !," Scroll to the bottom and change the number of characters per row to 255"
.W !," or higher. Click 'OK' to save your change."
.W !,"2. Click on 'capture setup' or 'tools, logging (arrow in lower right corner)'",!," depending on your setup. Ensure the logging settings form only has 'to disk'",!," selected and enter"
.W " the path and filename where the output should be stored."
.W !,"3. Click 'start capture' or 'start logging', depending on your interface."
.W !,"4. The DEVICE input for the columns should also contain a large enough",!," parameter (e.g. 255). The DEVICE prompt is defaulted to 0;255;99999 for you.",!," You may change it if need be." ;144
.W !,"Example: DEVICE: 0;255;99999 *Where 0 is your screen, 255 is the margin width",!?17,"and 99999 is the screen length."
.W !!,"NOTE: In order for all number fields, such as SSN and Feeder Key, to be",!,"displayed correctly in the spreadsheet, these fields must be formatted as Text",!,"when importing the data into the spreadsheet.",! ;144
.S DIC="^ECX(728.44,",FLDS="[ECX CLINIC REVIEW EXPORT]",BY="NUMBER",FR="",L=0
.;The following line has been patched in 136 and 144
.S DIOBEG="W ""IEN^Clinic^Stop Code^Credit Stop Code^Action^Last Approved Date^CHAR4 Code^MCA Labor Code^Inact Date^React Date^Clinic Type" ;154,166 CVW
.S DIOBEG=DIOBEG_"^App Len^Div^App Type^Non Cnt^OOS^OOS Calling Pkg^Var Length Appt^DSS Prod Dept^Non-OR DSS ID^PROVIDER STATION""" ;161,166,184
.S DIS(0)=$S(Y="U":"I $P(^ECX(728.44,D0,0),U,7)=""""",Y="I":"I $P(^ECX(728.44,D0,0),U,10)'=""""",Y="C":"I $P(^ECX(728.44,D0,0),U,10)=""""",1:"I 1") ;144
.S DIS(1)="I $P($G(^SC(D0,0)),U,3)=""C""" ;144 Only include clinics in report
.S %ZIS="N",%ZIS("B")="0;255;99999" D ^%ZIS Q:POP S IOP=ION_";"_IOM_";"_IOSL ;144
.D EN1^DIP
I ECALL="D" D
.K ^TMP("EC",$J)
.W !!,"Gathering data for export..."
.S FIRST=1,X=0,CCNT=1
.F DC=0:0 S DC=$O(^ECX(728.44,DC)) Q:'DC I $D(^ECX(728.44,DC,0)) S ECSDC=^ECX(728.44,DC,0) D
..I $P($G(^SC(DC,0)),U,3)'="C"!($P(^ECX(728.44,DC,0),U,10)'="") Q ;149 Don't include non clinic types or inactive ones
..S STOPC=$P(ECSDC,U,2),CREDSC=$P(ECSDC,U,3),NATC=$P(ECSDC,U,8) ;154 CVW
..S DIV=$$GET1^DIQ(44,$P(ECSDC,U),3.5,"I"),APPL=$$GET1^DIQ(44,$P(ECSDC,U),1912,"I"),ECXMCA=$$GET1^DIQ(728.442,$P(ECSDC,U,14),.01) ;166
..S STA6A=$$GET1^DIQ(4,$P(ECSDC,U,15),99,"E") ;184
..I 'FIRST D
...I $D(^TMP("EC",$J,1_STOPC_CREDSC_NATC_DIV_APPL_ECXMCA)) D ;166
....S ^TMP("EC",$J,1_STOPC_CREDSC_NATC_DIV_APPL_ECXMCA,0)="1" ;166
...S ECSC=$P(^SC(DC,0),U),^TMP("EC",$J,1_STOPC_CREDSC_NATC_DIV_APPL_ECXMCA,DC,ECSC)=ECSC_$S($P(ECSDC,U,10)'="":"*",1:"")_U_DC_U_STOPC_U_CREDSC_U_$$GET1^DIQ(728.441,NATC,.01)_U_ECXMCA_U_APPL_U_DIV_U_STA6A ;166,
..I FIRST D
...S ECSC=$P(^SC(DC,0),U),^TMP("EC",$J,1_STOPC_CREDSC_NATC_DIV_APPL_ECXMCA,DC,ECSC)=ECSC_$S($P(ECSDC,U,10)'="":"*",1:"")_U_DC_U_STOPC_U_CREDSC_U_$$GET1^DIQ(728.441,NATC,.01)_U_ECXMCA_U_APPL_U_DIV_U_STA6A,FIRST=0 ;166, 184 - Added STA6A
.K ^TMP($J,"ECXPORT")
.S ^TMP($J,"ECXPORT",0)="CLINIC NAME^CLINIC IEN^STOP CODE^CREDIT STOP CODE^CHAR4 CODE^MCA LABOR CODE^CLINIC APPOINTMENT LENGTH^DIVISION"
.S KEY="" F S KEY=$O(^TMP("EC",$J,KEY)) Q:'+KEY I $G(^TMP("EC",$J,KEY,0)) D
..S IEN=0 F S IEN=$O(^TMP("EC",$J,KEY,IEN)) Q:'+IEN S NAME="" F S NAME=$O(^TMP("EC",$J,KEY,IEN,NAME)) Q:NAME="" D
...S ^TMP($J,"ECXPORT",CCNT)=^TMP("EC",$J,KEY,IEN,NAME) ;161,166
...S CCNT=CCNT+1
..S ^TMP($J,"ECXPORT",CCNT)=U,CCNT=CCNT+1
.D EXPDISP^ECXUTL1
I '$G(POP) D ;144 Don't print the following lines if the report didn't print
.I ECALL'="D" D
..W !!,"Click 'stop capture' or 'tools, stop logging' to end logging..." ;174
..W !,"...Then, pull your export text file into your spreadsheet.",! ;144
..S DIR(0)="E",DIR("A")="Press any key to continue" D ^DIR K DIR
I IO'=IO(0) D ^%ZISC
D HOME^%ZIS
Q
EDIT ;Enter/Edit Clinic moved from ECXSCLD
N ECXSTA6A,ECXARR ;184
I '$O(^ECX(728.44,0)) W !,"DSS Clinic stop code file does not exist",!! R X:5 K X Q
;patch 142-added for loop to allow for new clinic prompt
F W ! K DIC S DIC=728.44,DIC(0)="QEAMZ",DIC("S")="I $P($G(^SC(Y,0)),U,3)=""C""" D ^DIC Q:Y<0 D ;149
.S CLIEN1=+Y
.W !!,"EXISTING CLINIC FILE DATA:" ;,?35,"EXISTING DSS CLINIC FILE DATA:" 154
.W !!,"STOP CODE: ",$P(Y(0),U,2) ;,?35,"DSS STOP CODE : ",$P(Y(0),U,4) 154
.W !,"CREDIT STOP CODE: ",$P(Y(0),U,3) ;,?35,"DSS CREDIT STOP CODE :",$P(Y(0),U,5) 154
.S ECXSTA6="",INSTIEN=$P(Y(0),U,15) ;184
.I INSTIEN'="" S ECXSTA6=$$GET1^DIQ(4,INSTIEN,99) ;184
.W !,"PROVIDER STATION: ",ECXSTA6 ;184
.W !
.D ENDCHK^ECXSCLD
.;D EDIT1 154 **EDIT1 code was moved to ECXSCLD1 for space
D ENDX^ECXSCLD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXSCLD1 12005 printed Dec 13, 2024@01:53:49 Page 2
ECXSCLD1 ;ALB/DAN <CONT> Enter, Print and Edit Entries in 728.44 ;4/4/19 15:52
+1 ;;3.0;DSS EXTRACTS;**132,136,144,149,154,161,166,174,184**;Dec 22, 1997;Build 124
+2 ;
HEAD ; header for worksheet 149 - moved from ECXSCLD due to size restraints.
+1 if PG
DO SS
if QFLG
QUIT
+2 ;154
NEW HEAD1
+3 ;154
SET HEAD1="WORKSHEET FOR DSS CLINIC STOPS"
+4 ;154
IF (ECALL="D")
SET HEAD1=HEAD1_" (DUPLICATE CLINIC LIST)"
+5 ;161
SET PG=PG+1
if $Y!($EXTRACT(IOST)="C")
WRITE @IOF
WRITE !,HEAD1,@$SELECT(ECALL="D":"?71",1:"?123"),"Page: ",PG
+6 ;144,161
WRITE !,$SELECT(ECDATE="":"(NEVER APPROVED)",1:"(last approved on "_ECDATE_")"),@$SELECT(ECALL="D":"?59",1:"?112"),"Print Date:",$TRANSLATE($$FMTE^XLFDT(DT,"2F")," ",0)
+7 ;149
IF (ECALL'="D")
Begin DoDot:1
+8 WRITE !
+9 ;154 CVW,161,166
WRITE !,?1,"CLINIC",?33,"STOP",?42,"CREDIT",?52,"ACTION",?63,"CHAR4",?70,"MCA",?77,"C/N",?87,"DSS",?108,"NON-OR"
+10 ;184
WRITE ?124,"PROVIDER"
+11 ;161,166
WRITE !,?33,"CODE",?42,"STOP",?63,"CODE",?70,"LABOR",?87,"PRODUCT",?108,"DSS"
+12 ;184
WRITE ?124,"STATION"
+13 ;144,149 CVW,161
WRITE !,?42,"CODE",?70,"CODE",?87,"DEPARTMENT",?108,"IDENTIFIER"
+14 ;154 CVW
WRITE !,"( * - currently inactive)"
+15 WRITE !,LN
End DoDot:1
+16 ;149
IF (ECALL="D")
Begin DoDot:1
+17 WRITE !
+18 ;154,161,166 CVW
WRITE !,"CLINIC NAME",?32,"CLINIC",?44,"STOP",?50,"CRED",?55,"CHAR4",?61,"MCA",?67,"CLINIC",?76,"DIV"
+19 ;184
WRITE ?82,"PROVIDER"
+20 ;154,161,166 CVW
WRITE !,?32,"IEN",?44,"CODE",?50,"STOP",?55,"CODE",?61,"LABOR",?67,"APPT"
+21 ;184
WRITE ?82,"LOCATION"
+22 ;154,161,166 CVW
WRITE !,?50,"CODE",?61,"CODE",?67,"LENGTH"
+23 WRITE !,LN
End DoDot:1
+24 QUIT
+25 ;
SS ;SCROLL STOPS 149 - moved from ECXSCLD due to size restraints.
+1 NEW JJ,SS
+2 WRITE !,LN
+3 ;W !,"Key: + - new clinic; ! - updated since last review; * - currently inactiv
+4 IF $EXTRACT(IOST)="C"
SET SS=21-$Y
FOR JJ=1:1:SS
WRITE !
+5 IF $EXTRACT(IOST)="C"
IF PG>0
SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
IF 'Y
SET QFLG=1
QUIT
+6 QUIT
+7 ;
ERRCHK(CODE,TYPE,CLIEN1) ;check for problems 149 - moved from ECXSCLD due to size restraints.
+1 ;input
+2 ; code: stop code IEN in #40.7
+3 ; type: type (3=dss stop code, 4=dss credit stop code)
+4 ; clien: clinic IEN in #728.44
+5 ;output
+6 ; ecxerr: error msg
+7 NEW XCODE,INACT,RTYPE,ERR,WRN
+8 KILL ECXERR,WARNING
+9 SET ECXERR=""
SET WARNING=""
SET ERR=0
+10 if '$GET(CODE)
QUIT -1
if '$GET(CLIEN1)
QUIT -1
+11 if (TYPE="")
QUIT -1
if ((TYPE<3)&(TYPE>4))
QUIT -1
+12 SET XCODE=$PIECE(^DIC(40.7,CODE,0),"^",2)
+13 SET TYPE=$SELECT(TYPE=3:"DSS Stop Code",1:"DSS Credit Stop Code")
+14 IF TYPE="DSS Stop Code"
DO STOP^ECXSTOP(XCODE,TYPE,,,CODE)
+15 IF TYPE="DSS Credit Stop Code"
DO STOP^ECXSTOP(XCODE,TYPE,CLIEN1,,CODE)
+16 IF $GET(ERR)>0
IF $DATA(ECXERR(1))
SET ERR=$ORDER(ECXERR(0))
SET ECXERR=ECXERR(ERR)
QUIT ECXERR
+17 IF '$TEST
SET ECXERR=""
QUIT ECXERR
+18 QUIT ECXERR
+19 ;
SHOWEM ; list clinics for worksheet 149 moved from ECXSCLD due to size.
+1 IF $Y+6>IOSL
DO HEAD
if QFLG
QUIT
+2 NEW ECNON1P
+3 SET ECNON=$PIECE(ECD,U,11)
SET ECNON1P=$EXTRACT(ECNON,1)
+4 ;if 'yes', then, 'n'on count clinic
SET ECNON1P=$SELECT(ECNON1P="Y":"N",1:"C")
+5 SET ECNON=ECNON1P_$EXTRACT(ECNON,2,99)
+6 ;161
WRITE !!,ECSC
+7 ;144
if $PIECE(ECD,U,9)]""
WRITE "*"
+8 WRITE ?33,$PIECE(ECD,U,1),?42,$PIECE(ECD,U,2),?55,$PIECE(ECD,U,5)
+9 ;F J=1:1:5 W ?$P("28,35,44,50,62",",",J),$S($P(ECD,U,J):$P(ECD,U,J),J<3:"",1:"_____")
+10 ;161
SET ECN=$PIECE($GET(^ECX(728.441,+$PIECE(ECD,U,7),0)),U)
WRITE ?63,$SELECT(ECN]"":ECN,1:"____"),?70,$$GET1^DIQ(728.442,$PIECE(ECD,U,13),.01),?78,ECNON,?87,$PIECE(ECD,U,10),?108,$PIECE(ECD,U,8)
+11 ;184
WRITE ?124,$$GET1^DIQ(4,$PIECE(ECD,U,14),99,"E")
+12 QUIT
ERRPRNT ;print errors
+1 IF $GET(ERR)>0
IF $DATA(ECXERR)
Begin DoDot:1
+2 WRITE !
SET I=0
FOR
SET I=$ORDER(ECXERR(I))
if 'I
QUIT
Begin DoDot:2
+3 WRITE !,"..",ECXERR(I)
End DoDot:2
End DoDot:1
+4 IF $GET(WRN)>0
IF $DATA(WARNING)
Begin DoDot:1
+5 WRITE !
SET I=0
FOR
SET I=$ORDER(WARNING(I))
if 'I
QUIT
Begin DoDot:2
+6 WRITE !,"..",WARNING(I)
End DoDot:2
End DoDot:1
+7 QUIT
EDIT1 ;check input & update field #3; allow '@' deletion; allow bypass empty with no entry
+1 ;**NOTE THIS CODE IS NOT CURRENT as of patch 154, and it was moved here from ECXSCLD due
+2 ;to size constraints. The code was left as documentation of what was changed, and for potential
+3 ;re-instatement by the customer. Please note, there are calls that would need to be updated if used
+4 ;again from within this routine.
+5 ;N DIR ;136
+6 ;S OUT=0 F D Q:OUT
+7 ;.K DIC,DIR,ECXMSG,FDA,AMIS,X,Y
+8 ;.S STOP=$P(^ECX(728.44,CLIEN1,0),U,4)
+9 ;.S DIR(0)="FO^1:99",DIR("A")="DSS STOP CODE (3-digit code only)" I STOP]"" S DIR("B")=STOP
+10 ;.S DIR("?")="^S DIC=40.7,DIC(0)=""EMQZ"" D ^DIC"
+11 ;.D ^DIR
+12 ;.I X="@" D Q
+13 ;..S IENS=CLIEN1_",",FDA(728.44,IENS,3)=X D FILE^DIE("","FDA")
+14 ;..S OUT=1 W " deleted..."
+15 ;.I X="" S X=STOP K DIRUT S OUT=2 Q
+16 ;.S DIC("A")="DSS STOP CODE (3-digit code only): "
+17 ;.S DIC="^DIC(40.7,",DIC(0)="EMQZ"
+18 ;.S DIC("S")="I $P(^(0),U,3)=""""" D ^DIC
+19 ;.I X="@" D Q
+20 ;..S IENS=CLIEN1_",",FDA(728.44,IENS,3)=X D FILE^DIE("","FDA")
+21 ;..S OUT=2 W " deleted..."
+22 ;.I X="" K DIRUT S OUT=2 Q
+23 ;.I ($G(DIRUT)!$G(DUOUT)!$G(DTOUT)) S OUT=3 Q
+24 ;.I +X'=X W !,?5,"Invalid... try again." Q
+25 ;.I +Y'>0 Q
+26 ;.S AMIS=$P(^DIC(40.7,+Y,0),"^",2)
+27 ;.S CODE=+Y,ECXMSG=$$ERRCHK(CODE,3,CLIEN1)
+28 ;.I ECXMSG=-1 W !,?5,"Invalid... try again." Q
+29 ;.I $G(ECXMSG)]"" W !,?5,ECXMSG,! Q
+30 ;.S IENS=CLIEN1_",",FDA(728.44,IENS,3)=AMIS D FILE^DIE("U","FDA")
+31 ;.S OUT=1
+32 ;I ($G(DIRUT)!$G(DUOUT)!$G(DTOUT)) G ENDX
+33 ;check input & update field #4; allow '@' deletion; allow bypass empty with no entry
+34 ;S OUT=0 F D G:OUT=1 ENDCHK
+35 ;.K DIC,DIR,ECXMSG,FDA,AMIS,X,Y
+36 ;.S CSTOP=$P(^ECX(728.44,CLIEN1,0),U,5)
+37 ;.S DIR(0)="FO^1:99",DIR("A")="DSS CREDIT STOP CODE (3-digit code only)" I CSTOP]"" S DIR("B")=CSTOP
+38 ;.S DIR("?")="^S DIC=40.7,DIC(0)=""EMQZ"" D ^DIC"
+39 ;.D ^DIR
+40 ;.I X="@" D Q
+41 ;..S IENS=CLIEN1_",",FDA(728.44,IENS,4)=X D FILE^DIE("","FDA")
+42 ;..S OUT=1 W " deleted..."
+43 ;.I X="" S X=CSTOP K DIRUT S OUT=1 Q
+44 ;.S DIC("A")="DSS CREDIT STOP CODE (3-digit code only): "
+45 ;.S DIC("S")="I $P(^(0),U,3)=""""" D ^DIC
+46 ;.S DIC=40.7,DIC(0)="EMQZ" D ^DIC
+47 ;.I X="" K DIRUT S OUT=1 Q
+48 ;.I ($G(DIRUT)!$G(DUOUT)!$G(DTOUT)) S OUT=1 Q
+49 ;.I +X'=X W !,?5,"Invalid... try again." Q
+50 ;.I +Y'>0 Q
+51 ;.S AMIS=$P(^DIC(40.7,+Y,0),"^",2)
+52 ;.S CODE=+Y,ECXMSG=$$ERRCHK(CODE,4,CLIEN1)
+53 ;.I ECXMSG=-1 W !,?5,"Invalid... try again." Q
+54 ;.I $G(ECXMSG)]"" W !,?5,ECXMSG,! Q
+55 ;.S IENS=CLIEN1_",",FDA(728.44,IENS,4)=AMIS D FILE^DIE("U","FDA")
+56 ;.S OUT=1
+57 ;I ($G(DIRUT)!$G(DUOUT)!$G(DTOUT)) G ENDX
+58 ;K I,WARNING,DIC,DIE,DA,DR,DIR,DIRUT,DTOUT,DUOUT,X,Y,ERRCHK
+59 ;K CLIEN1,CODE,ECXMSG,IENS,STOP,CSTOP,AMIS,FDA,OUT,ERR,WRN,ECXERR
+60 QUIT
EXPORT ;Export clinic review data to spreedsheet
+1 ;144,166
NEW DIC,DIR,FLDS,BY,FR,L,DIOBEG,DIR,DIS,Y,DIRUT,POP,DUOUT,DTOUT,DIROUT,X,%ZIS,IOP,CCNT,ECXCLX,APPL,ECXMCA
+2 ;184
NEW STA6A
+3 ;144
WRITE !!,"Select which clinics to include on the spreadsheet for exporting."
+4 ;149
SET DIR(0)="SAO^A:ALL CLINICS;C:ACTIVE CLINICS;D:DUPLICATE CLINICS;I:INACTIVE CLINICS;U:UNREVIEWED CLINICS"
SET DIR("?")="Enter letter associated with the group of clinics to include on the spreadsheet"
+5 ;149
SET DIR("A",1)="Select (A)ll, a(C)tive, (D)uplicate, (I)nactive, "
+6 SET DIR("A")="or (U)nreviewed clinics for export: "
+7 ;144 Stop if no selection made
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
QUIT
+8 SET ECALL=$EXTRACT(Y)
+9 IF ECALL'="D"
Begin DoDot:1
+10 ;144
WRITE !!,"To ensure all data is captured during the export:"
+11 ;174 Update logging instructions
+12 ;184 Update the width from 225 to 255 characters.
+13 WRITE !!,"1. In reflections, change the row margin by clicking on one of the change margin",!," icons with a value of 255 or higher if you have them."
+14 WRITE !," You may also set the margin manually by clicking on appearance, expanded",!," terminal settings (arrow in lower right corner), set up display settings."
+15 WRITE !," Scroll to the bottom and change the number of characters per row to 255"
+16 WRITE !," or higher. Click 'OK' to save your change."
+17 WRITE !,"2. Click on 'capture setup' or 'tools, logging (arrow in lower right corner)'",!," depending on your setup. Ensure the logging settings form only has 'to disk'",!," selected and enter"
+18 WRITE " the path and filename where the output should be stored."
+19 WRITE !,"3. Click 'start capture' or 'start logging', depending on your interface."
+20 ;144
WRITE !,"4. The DEVICE input for the columns should also contain a large enough",!," parameter (e.g. 255). The DEVICE prompt is defaulted to 0;255;99999 for you.",!," You may change it if need be."
+21 WRITE !,"Example: DEVICE: 0;255;99999 *Where 0 is your screen, 255 is the margin width",!?17,"and 99999 is the screen length."
+22 ;144
WRITE !!,"NOTE: In order for all number fields, such as SSN and Feeder Key, to be",!,"displayed correctly in the spreadsheet, these fields must be formatted as Text",!,"when importing the data into the spreadsheet.",!
+23 SET DIC="^ECX(728.44,"
SET FLDS="[ECX CLINIC REVIEW EXPORT]"
SET BY="NUMBER"
SET FR=""
SET L=0
+24 ;The following line has been patched in 136 and 144
+25 ;154,166 CVW
SET DIOBEG="W ""IEN^Clinic^Stop Code^Credit Stop Code^Action^Last Approved Date^CHAR4 Code^MCA Labor Code^Inact Date^React Date^Clinic Type"
+26 ;161,166,184
SET DIOBEG=DIOBEG_"^App Len^Div^App Type^Non Cnt^OOS^OOS Calling Pkg^Var Length Appt^DSS Prod Dept^Non-OR DSS ID^PROVIDER STATION"""
+27 ;144
SET DIS(0)=$SELECT(Y="U":"I $P(^ECX(728.44,D0,0),U,7)=""""",Y="I":"I $P(^ECX(728.44,D0,0),U,10)'=""""",Y="C":"I $P(^ECX(728.44,D0,0),U,10)=""""",1:"I 1")
+28 ;144 Only include clinics in report
SET DIS(1)="I $P($G(^SC(D0,0)),U,3)=""C"""
+29 ;144
SET %ZIS="N"
SET %ZIS("B")="0;255;99999"
DO ^%ZIS
if POP
QUIT
SET IOP=ION_";"_IOM_";"_IOSL
+30 DO EN1^DIP
End DoDot:1
+31 IF ECALL="D"
Begin DoDot:1
+32 KILL ^TMP("EC",$JOB)
+33 WRITE !!,"Gathering data for export..."
+34 SET FIRST=1
SET X=0
SET CCNT=1
+35 FOR DC=0:0
SET DC=$ORDER(^ECX(728.44,DC))
if 'DC
QUIT
IF $DATA(^ECX(728.44,DC,0))
SET ECSDC=^ECX(728.44,DC,0)
Begin DoDot:2
+36 ;149 Don't include non clinic types or inactive ones
IF $PIECE($GET(^SC(DC,0)),U,3)'="C"!($PIECE(^ECX(728.44,DC,0),U,10)'="")
QUIT
+37 ;154 CVW
SET STOPC=$PIECE(ECSDC,U,2)
SET CREDSC=$PIECE(ECSDC,U,3)
SET NATC=$PIECE(ECSDC,U,8)
+38 ;166
SET DIV=$$GET1^DIQ(44,$PIECE(ECSDC,U),3.5,"I")
SET APPL=$$GET1^DIQ(44,$PIECE(ECSDC,U),1912,"I")
SET ECXMCA=$$GET1^DIQ(728.442,$PIECE(ECSDC,U,14),.01)
+39 ;184
SET STA6A=$$GET1^DIQ(4,$PIECE(ECSDC,U,15),99,"E")
+40 IF 'FIRST
Begin DoDot:3
+41 ;166
IF $DATA(^TMP("EC",$JOB,1_STOPC_CREDSC_NATC_DIV_APPL_ECXMCA))
Begin DoDot:4
+42 ;166
SET ^TMP("EC",$JOB,1_STOPC_CREDSC_NATC_DIV_APPL_ECXMCA,0)="1"
End DoDot:4
+43 ;166,
SET ECSC=$PIECE(^SC(DC,0),U)
SET ^TMP("EC",$JOB,1_STOPC_CREDSC_NATC_DIV_APPL_ECXMCA,DC,ECSC)=ECSC_$SELECT($PIECE(ECSDC,U,10)'="":"*",1:"")_U_DC_U_STOPC_U_CREDSC_U_$$GET1^DIQ(728.441,NATC,.01)_U_ECXMCA_U_APPL_U_DIV_U_STA6A
End DoDot:3
+44 IF FIRST
Begin DoDot:3
+45 ;166, 184 - Added STA6A
SET ECSC=$PIECE(^SC(DC,0),U)
SET ^TMP("EC",$JOB,1_STOPC_CREDSC_NATC_DIV_APPL_ECXMCA,DC,ECSC)=ECSC_$SELECT($PIECE(ECSDC,U,10)'="":"*",1:"")_U_DC_U_STOPC_U_CREDSC_U_$$GET1^DIQ(728.441,NATC,.01)_U_ECXMCA_U_APPL_U_DIV_U_STA6A
SET FIRST=0
End DoDot:3
End DoDot:2
+46 KILL ^TMP($JOB,"ECXPORT")
+47 SET ^TMP($JOB,"ECXPORT",0)="CLINIC NAME^CLINIC IEN^STOP CODE^CREDIT STOP CODE^CHAR4 CODE^MCA LABOR CODE^CLINIC APPOINTMENT LENGTH^DIVISION"
+48 SET KEY=""
FOR
SET KEY=$ORDER(^TMP("EC",$JOB,KEY))
if '+KEY
QUIT
IF $GET(^TMP("EC",$JOB,KEY,0))
Begin DoDot:2
+49 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("EC",$JOB,KEY,IEN))
if '+IEN
QUIT
SET NAME=""
FOR
SET NAME=$ORDER(^TMP("EC",$JOB,KEY,IEN,NAME))
if NAME=""
QUIT
Begin DoDot:3
+50 ;161,166
SET ^TMP($JOB,"ECXPORT",CCNT)=^TMP("EC",$JOB,KEY,IEN,NAME)
+51 SET CCNT=CCNT+1
End DoDot:3
+52 SET ^TMP($JOB,"ECXPORT",CCNT)=U
SET CCNT=CCNT+1
End DoDot:2
+53 DO EXPDISP^ECXUTL1
End DoDot:1
+54 ;144 Don't print the following lines if the report didn't print
IF '$GET(POP)
Begin DoDot:1
+55 IF ECALL'="D"
Begin DoDot:2
+56 ;174
WRITE !!,"Click 'stop capture' or 'tools, stop logging' to end logging..."
+57 ;144
WRITE !,"...Then, pull your export text file into your spreadsheet.",!
+58 SET DIR(0)="E"
SET DIR("A")="Press any key to continue"
DO ^DIR
KILL DIR
End DoDot:2
End DoDot:1
+59 IF IO'=IO(0)
DO ^%ZISC
+60 DO HOME^%ZIS
+61 QUIT
EDIT ;Enter/Edit Clinic moved from ECXSCLD
+1 ;184
NEW ECXSTA6A,ECXARR
+2 IF '$ORDER(^ECX(728.44,0))
WRITE !,"DSS Clinic stop code file does not exist",!!
READ X:5
KILL X
QUIT
+3 ;patch 142-added for loop to allow for new clinic prompt
+4 ;149
FOR
WRITE !
KILL DIC
SET DIC=728.44
SET DIC(0)="QEAMZ"
SET DIC("S")="I $P($G(^SC(Y,0)),U,3)=""C"""
DO ^DIC
if Y<0
QUIT
Begin DoDot:1
+5 SET CLIEN1=+Y
+6 ;,?35,"EXISTING DSS CLINIC FILE DATA:" 154
WRITE !!,"EXISTING CLINIC FILE DATA:"
+7 ;,?35,"DSS STOP CODE : ",$P(Y(0),U,4) 154
WRITE !!,"STOP CODE: ",$PIECE(Y(0),U,2)
+8 ;,?35,"DSS CREDIT STOP CODE :",$P(Y(0),U,5) 154
WRITE !,"CREDIT STOP CODE: ",$PIECE(Y(0),U,3)
+9 ;184
SET ECXSTA6=""
SET INSTIEN=$PIECE(Y(0),U,15)
+10 ;184
IF INSTIEN'=""
SET ECXSTA6=$$GET1^DIQ(4,INSTIEN,99)
+11 ;184
WRITE !,"PROVIDER STATION: ",ECXSTA6
+12 WRITE !
+13 DO ENDCHK^ECXSCLD
+14 ;D EDIT1 154 **EDIT1 code was moved to ECXSCLD1 for space
End DoDot:1
+15 DO ENDX^ECXSCLD
+16 QUIT
