- 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 Feb 18, 2025@23:20:13 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
