- SDCO0 ;ALB/RMO - Build List Area - Check Out;11 FEB 1993 10:00 am ; 6/22/05 12:56pm
- ;;5.3;Scheduling;**20,44,132,180,351,441,586**;Aug 13, 1993;Build 28
- ;
- EN(SDARY,SDOE,SDSTART,SDTOT) ;Entry point Called by Ck Out & Apt Mgr Exp Dis
- S SDTOT=0
- D CL(SDARY,SDOE,SDSTART,.SDTOT)
- D PR(SDARY,SDOE,SDSTART,.SDTOT)
- D DX(SDARY,SDOE,SDSTART,.SDTOT)
- I $P($G(^SCE(+SDOE,0)),"^",8)'=2 D SC(SDARY,SDOE,SDSTART,.SDTOT)
- Q
- ;
- CL(SDARY,SDOE,SDSTART,SDTOT) ;Build classification (Pg: 1 Row: SDSTART-SDSTART+7 Col: 1-80)
- N SDCLOEY,SDCNI,SDCNT,SDCTI,SDCTIS,SDCTS,SDEND,SDLINE,SDNA,SDVAL,X
- S SDLINE=SDSTART,SDEND=SDSTART+8
- D SET(SDARY,SDLINE," CLASSIFICATION ",5,IORVON,IORVOFF,"","","",.SDTOT)
- D CLASK^SDCO2(SDOE,.SDCLOEY)
- D SET(SDARY,SDLINE,"["_$S($D(SDCLOEY):"Required",1:"Not Required")_"]",24,"","","","","",.SDTOT)
- S SDCNT=0,SDCTIS=$$SEQ^SDCO21
- F SDCTS=1:1 S SDCTI=+$P(SDCTIS,",",SDCTS) Q:'SDCTI D
- .S SDCNT=SDCNT+1,SDLINE=SDLINE+1
- .S:$D(SDCLOEY(SDCTI)) SDVAL=$$VAL^SDCODD(SDCTI,$P(SDCLOEY(SDCTI),"^",2)),SDNA=+$P(SDCLOEY(SDCTI),"^",3)
- .S X=$S('$D(SDCLOEY(SDCTI)):"Not Applicable",$$COMDT^SDCOU(SDOE)&(SDVAL=""):"Not Applicable",SDVAL="":"Unanswered",1:SDVAL)
- .D SET(SDARY,SDLINE,SDCNT_" "_$J($P($G(^SD(409.41,SDCTI,0)),"^",6)_": ",32)_X,2,"","","CL",SDCNT,+$G(SDCLOEY(SDCTI))_"^"_SDCTI,.SDTOT)
- F SDLINE=SDLINE+1:1:SDEND D SET(SDARY,SDLINE,"",1,"","","","","",.SDTOT)
- Q
- ;
- PR(SDARY,SDOE,SDSTART,SDTOT) ;Build Provider (Pg: 1 Row: SDSTART+8-END Col: 1-40)
- N SDCNT,SDLINE,SDPR,SDVPRV
- S SDLINE=SDSTART+9
- D SET(SDARY,SDLINE," PROVIDER ",5,IORVON,IORVOFF,"","","",.SDTOT)
- D SET(SDARY,SDLINE,"["_$S($$PRASK^SDCO3(SDOE)=1:"Required",1:"Not Required")_"]",18,"","","","","",.SDTOT)
- ;
- ; -- get provider data
- D GETPRV^SDOE(SDOE,"SDPR")
- S (SDCNT,SDVPRV)=0
- F S SDVPRV=$O(SDPR(SDVPRV)) Q:'SDVPRV D
- . S SDCNT=SDCNT+1
- . S SDLINE=SDLINE+1
- . D SET(SDARY,SDLINE,SDCNT_" "_$$PR^SDCO31(+SDPR(SDVPRV)),2,"","","PR",SDCNT,SDVPRV_"^"_+SDPR(SDVPRV),.SDTOT)
- Q
- ;
- DX(SDARY,SDOE,SDSTART,SDTOT) ;Build Diagnosis (Pg: 1 Row: SDSTART+8-END Col: 42-80)
- N SDCNT,SDDXS,SDDXD,SDVPOV,SDLINE,ICDVDT,IMPDT,DXARY,TXT,I
- S SDLINE=SDSTART+9
- D SET(SDARY,SDLINE," DIAGNOSIS ",45,IORVON,IORVOFF,"","","",.SDTOT)
- D SET(SDARY,SDLINE,"["_$S($$DXASK^SDCO4(SDOE)=1:"Required",1:"Not Required")_"]",59,"","","","","",.SDTOT)
- ;
- ; -- get dxs data
- D GETDX^SDOE(SDOE,"SDDXS")
- S (SDCNT,SDVPOV)=0
- S IMPDT=$$IMP^ICDEX(30)
- F S SDVPOV=$O(SDDXS(SDVPOV)) Q:'SDVPOV D
- . S SDCNT=SDCNT+1
- . S SDLINE=SDLINE+1
- . S ICDVDT=$S($P(SDDXS(SDVPOV),"^",3)'="":$$GET1^DIQ(9000010,$P(SDDXS(SDVPOV),"^",3),.01,"I"),1:"")
- . S SDDXD=$$DX^SDCO41(+SDDXS(SDVPOV),ICDVDT)
- . D SET(SDARY,SDLINE,SDCNT_" "_$P(SDDXD,"^"),42,"","","","","",.SDTOT)
- . I ICDVDT<IMPDT D Q
- . . D SET(SDARY,SDLINE,$P(SDDXD,"^",2),55,"","","DX",SDCNT,SDVPOV_"^"_+SDDXS(SDVPOV),.SDTOT)
- . D DXFTXT($P(SDDXD,"^",2),.DXARY) S I="" F S I=$O(DXARY(I)) Q:I="" S TXT=DXARY(I) D
- . . I I=1 D SET(SDARY,SDLINE,TXT,55,"","","DX",SDCNT,SDVPOV_"^"_+SDDXS(SDVPOV),.SDTOT) Q
- . . S SDLINE=SDLINE+1 D SET(SDARY,SDLINE,TXT,55,"","","","","",.SDTOT)
- Q
- ;
- SC(SDARY,SDOEP,SDSTART,SDTOT) ;Build Stop Codes (Pg: 2 Row: SDTOT+1 Col: 1-80)
- N SDLINE,SDONE
- F SDLINE=SDTOT+1:1:SDSTART+VALM("LINES")+1 D SET(SDARY,SDLINE,"",1,"","","","","",.SDTOT)
- D SET(SDARY,SDLINE," STOP CODES ",5,IORVON,IORVOFF,"","","",.SDTOT)
- D SET(SDARY,SDLINE,"[Stop Codes Not Required / Procedures Required]",28,"","","","","",.SDTOT)
- D AE(SDARY,SDOEP,.SDLINE,.SDTOT,.SDONE)
- S SDOE=0
- F S SDOE=$O(^SCE("APAR",SDOEP,SDOE)) Q:'SDOE D AE(SDARY,SDOE,.SDLINE,.SDTOT,.SDONE)
- Q
- ;
- AE(SDARY,SDOE,SDLINE,SDTOT,SDONE) ; -- add/edits
- N SDOE0,SDT,DFN,SDVIEN,CPTS,SDCNT,SDVCPT0,SDVCPT,SDSCD0,X
- S SDOE0=$G(^SCE(+SDOE,0))
- S SDT=+SDOE0
- S DFN=+$P(SDOE0,"^",2)
- S SDSC=+$P(SDOE0,U,3)
- S SDCL=+$P(SDOE0,U,4)
- S SDVIEN=+$P(SDOE0,U,5)
- ;
- ; -- quit if visit already processed
- G:$D(SDONE(SDVIEN)) AEQ
- ;
- S SDSCD0=$G(^DIC(40.7,SDSC,0))
- S SDLINE=SDLINE+1
- D SET(SDARY,SDLINE,$P(SDSCD0,"^",2)_" "_$E($P(SDSCD0,"^"),1,30),5,"","","","","",.SDTOT)
- ;
- ; -- get cpts and loop
- D GETCPT^SDOE(SDOE,"CPTS")
- S (SDCNT,SDVCPT)=0
- N MODINFO,MODPTR,MODTEXT,PTR,MODCODE,CPTINFO,ICPTVDT
- F S SDVCPT=+$O(CPTS(SDVCPT)) Q:'SDVCPT D
- .; S SDVCPT0=$G(CPTS(SDVCPT))
- .; S SDCNT=SDCNT+1
- . S SDLINE=SDLINE+1
- . D SET(SDARY,SDLINE,"Procedure(s):",12,"","","","","",.SDTOT)
- .;
- .; IF $D(^ICPT(+SDVCPT0,0)) S X=^(0) D
- .; N CPTINFO
- . S ICPTVDT=$S($P(CPTS(SDVCPT),"^",3)'="":$$GET1^DIQ(9000010,$P(CPTS(SDVCPT),"^",3),.01,"I"),1:"")
- . S CPTINFO=$$CPT^ICPTCOD(+$G(CPTS(SDVCPT)),ICPTVDT,1)
- . S:CPTINFO>0 X=$P(CPTINFO,"^",2,99),X=$P(X,"^")_" x "_$P($G(CPTS(SDVCPT)),"^",16)_" "_$P(X,"^",2)
- . S:CPTINFO'>0 X="Procedure not defined"
- . ;
- . D SET(SDARY,SDLINE,$E(X,1,40),27,"","","","","",.SDTOT)
- . ;
- . ;Retrieve Procedure (CPT) Codes and associated Modifiers
- . S PTR=0
- . F S PTR=+$O(CPTS(SDVCPT,1,PTR)) Q:'PTR D
- . . S MODPTR=$G(CPTS(SDVCPT,1,PTR,0))
- . . Q:'MODPTR
- . . S MODINFO=$$MOD^ICPTMOD(MODPTR,"I",ICPTVDT,1)
- . . Q:MODINFO'>0
- . . S MODCODE="-"_$P(MODINFO,"^",2)
- . . S MODTEXT=$P(MODINFO,"^",3)
- . . S SDLINE=SDLINE+1
- . . D SET(SDARY,SDLINE,MODCODE,29,"","","","","",.SDTOT)
- . . D SET(SDARY,SDLINE,MODTEXT,38,"","","","","",.SDTOT)
- . . Q
- ;
- ; -- set indicator that visit was processed
- S SDONE(SDVIEN)=""
- AEQ Q
- ;
- SET(SDARY,LINE,TEXT,COL,ON,OFF,SDSUB,SDCNT,SDATA,SDTOT) ; -- set display array
- N X
- S:LINE>SDTOT SDTOT=LINE
- S X=$S($D(^TMP(SDARY,$J,LINE,0)):^(0),1:"")
- S ^TMP(SDARY,$J,LINE,0)=$$SETSTR^VALM1(TEXT,X,COL,$L(TEXT))
- D:$G(ON)]""!($G(OFF)]"") CNTRL^VALM10(LINE,COL,$L(TEXT),$G(ON),$G(OFF))
- S:$G(SDSUB)]"" ^TMP("SDCOIDX",$J,SDSUB,SDCNT,SDLINE)=SDATA,^TMP("SDCOIDX",$J,SDSUB,0)=SDCNT
- Q
- DXFTXT(DXTXT,DXARY) ; -- formatted diagnosis text
- N DIWL,DIWR,X
- K ^UTILITY($J,"W"),DXARY
- S DIWL=1,DIWR=26,X=$$SENTENCE^XLFSTR(DXTXT)
- D ^DIWP
- S X=""
- F S X=$O(^UTILITY($J,"W",1,X)) Q:X="" D
- . S DXARY(X)=$G(^UTILITY($J,"W",1,X,0))
- K ^UTILITY($J,"W")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCO0 6087 printed Feb 19, 2025@00:15:43 Page 2
- SDCO0 ;ALB/RMO - Build List Area - Check Out;11 FEB 1993 10:00 am ; 6/22/05 12:56pm
- +1 ;;5.3;Scheduling;**20,44,132,180,351,441,586**;Aug 13, 1993;Build 28
- +2 ;
- EN(SDARY,SDOE,SDSTART,SDTOT) ;Entry point Called by Ck Out & Apt Mgr Exp Dis
- +1 SET SDTOT=0
- +2 DO CL(SDARY,SDOE,SDSTART,.SDTOT)
- +3 DO PR(SDARY,SDOE,SDSTART,.SDTOT)
- +4 DO DX(SDARY,SDOE,SDSTART,.SDTOT)
- +5 IF $PIECE($GET(^SCE(+SDOE,0)),"^",8)'=2
- DO SC(SDARY,SDOE,SDSTART,.SDTOT)
- +6 QUIT
- +7 ;
- CL(SDARY,SDOE,SDSTART,SDTOT) ;Build classification (Pg: 1 Row: SDSTART-SDSTART+7 Col: 1-80)
- +1 NEW SDCLOEY,SDCNI,SDCNT,SDCTI,SDCTIS,SDCTS,SDEND,SDLINE,SDNA,SDVAL,X
- +2 SET SDLINE=SDSTART
- SET SDEND=SDSTART+8
- +3 DO SET(SDARY,SDLINE," CLASSIFICATION ",5,IORVON,IORVOFF,"","","",.SDTOT)
- +4 DO CLASK^SDCO2(SDOE,.SDCLOEY)
- +5 DO SET(SDARY,SDLINE,"["_$SELECT($DATA(SDCLOEY):"Required",1:"Not Required")_"]",24,"","","","","",.SDTOT)
- +6 SET SDCNT=0
- SET SDCTIS=$$SEQ^SDCO21
- +7 FOR SDCTS=1:1
- SET SDCTI=+$PIECE(SDCTIS,",",SDCTS)
- if 'SDCTI
- QUIT
- Begin DoDot:1
- +8 SET SDCNT=SDCNT+1
- SET SDLINE=SDLINE+1
- +9 if $DATA(SDCLOEY(SDCTI))
- SET SDVAL=$$VAL^SDCODD(SDCTI,$PIECE(SDCLOEY(SDCTI),"^",2))
- SET SDNA=+$PIECE(SDCLOEY(SDCTI),"^",3)
- +10 SET X=$SELECT('$DATA(SDCLOEY(SDCTI)):"Not Applicable",$$COMDT^SDCOU(SDOE)&(SDVAL=""):"Not Applicable",SDVAL="":"Unanswered",1:SDVAL)
- +11 DO SET(SDARY,SDLINE,SDCNT_" "_$JUSTIFY($PIECE($GET(^SD(409.41,SDCTI,0)),"^",6)_": ",32)_X,2,"","","CL",SDCNT,+$GET(SDCLOEY(SDCTI))_"^"_SDCTI,.SDTOT)
- End DoDot:1
- +12 FOR SDLINE=SDLINE+1:1:SDEND
- DO SET(SDARY,SDLINE,"",1,"","","","","",.SDTOT)
- +13 QUIT
- +14 ;
- PR(SDARY,SDOE,SDSTART,SDTOT) ;Build Provider (Pg: 1 Row: SDSTART+8-END Col: 1-40)
- +1 NEW SDCNT,SDLINE,SDPR,SDVPRV
- +2 SET SDLINE=SDSTART+9
- +3 DO SET(SDARY,SDLINE," PROVIDER ",5,IORVON,IORVOFF,"","","",.SDTOT)
- +4 DO SET(SDARY,SDLINE,"["_$SELECT($$PRASK^SDCO3(SDOE)=1:"Required",1:"Not Required")_"]",18,"","","","","",.SDTOT)
- +5 ;
- +6 ; -- get provider data
- +7 DO GETPRV^SDOE(SDOE,"SDPR")
- +8 SET (SDCNT,SDVPRV)=0
- +9 FOR
- SET SDVPRV=$ORDER(SDPR(SDVPRV))
- if 'SDVPRV
- QUIT
- Begin DoDot:1
- +10 SET SDCNT=SDCNT+1
- +11 SET SDLINE=SDLINE+1
- +12 DO SET(SDARY,SDLINE,SDCNT_" "_$$PR^SDCO31(+SDPR(SDVPRV)),2,"","","PR",SDCNT,SDVPRV_"^"_+SDPR(SDVPRV),.SDTOT)
- End DoDot:1
- +13 QUIT
- +14 ;
- DX(SDARY,SDOE,SDSTART,SDTOT) ;Build Diagnosis (Pg: 1 Row: SDSTART+8-END Col: 42-80)
- +1 NEW SDCNT,SDDXS,SDDXD,SDVPOV,SDLINE,ICDVDT,IMPDT,DXARY,TXT,I
- +2 SET SDLINE=SDSTART+9
- +3 DO SET(SDARY,SDLINE," DIAGNOSIS ",45,IORVON,IORVOFF,"","","",.SDTOT)
- +4 DO SET(SDARY,SDLINE,"["_$SELECT($$DXASK^SDCO4(SDOE)=1:"Required",1:"Not Required")_"]",59,"","","","","",.SDTOT)
- +5 ;
- +6 ; -- get dxs data
- +7 DO GETDX^SDOE(SDOE,"SDDXS")
- +8 SET (SDCNT,SDVPOV)=0
- +9 SET IMPDT=$$IMP^ICDEX(30)
- +10 FOR
- SET SDVPOV=$ORDER(SDDXS(SDVPOV))
- if 'SDVPOV
- QUIT
- Begin DoDot:1
- +11 SET SDCNT=SDCNT+1
- +12 SET SDLINE=SDLINE+1
- +13 SET ICDVDT=$SELECT($PIECE(SDDXS(SDVPOV),"^",3)'="":$$GET1^DIQ(9000010,$PIECE(SDDXS(SDVPOV),"^",3),.01,"I"),1:"")
- +14 SET SDDXD=$$DX^SDCO41(+SDDXS(SDVPOV),ICDVDT)
- +15 DO SET(SDARY,SDLINE,SDCNT_" "_$PIECE(SDDXD,"^"),42,"","","","","",.SDTOT)
- +16 IF ICDVDT<IMPDT
- Begin DoDot:2
- +17 DO SET(SDARY,SDLINE,$PIECE(SDDXD,"^",2),55,"","","DX",SDCNT,SDVPOV_"^"_+SDDXS(SDVPOV),.SDTOT)
- End DoDot:2
- QUIT
- +18 DO DXFTXT($PIECE(SDDXD,"^",2),.DXARY)
- SET I=""
- FOR
- SET I=$ORDER(DXARY(I))
- if I=""
- QUIT
- SET TXT=DXARY(I)
- Begin DoDot:2
- +19 IF I=1
- DO SET(SDARY,SDLINE,TXT,55,"","","DX",SDCNT,SDVPOV_"^"_+SDDXS(SDVPOV),.SDTOT)
- QUIT
- +20 SET SDLINE=SDLINE+1
- DO SET(SDARY,SDLINE,TXT,55,"","","","","",.SDTOT)
- End DoDot:2
- End DoDot:1
- +21 QUIT
- +22 ;
- SC(SDARY,SDOEP,SDSTART,SDTOT) ;Build Stop Codes (Pg: 2 Row: SDTOT+1 Col: 1-80)
- +1 NEW SDLINE,SDONE
- +2 FOR SDLINE=SDTOT+1:1:SDSTART+VALM("LINES")+1
- DO SET(SDARY,SDLINE,"",1,"","","","","",.SDTOT)
- +3 DO SET(SDARY,SDLINE," STOP CODES ",5,IORVON,IORVOFF,"","","",.SDTOT)
- +4 DO SET(SDARY,SDLINE,"[Stop Codes Not Required / Procedures Required]",28,"","","","","",.SDTOT)
- +5 DO AE(SDARY,SDOEP,.SDLINE,.SDTOT,.SDONE)
- +6 SET SDOE=0
- +7 FOR
- SET SDOE=$ORDER(^SCE("APAR",SDOEP,SDOE))
- if 'SDOE
- QUIT
- DO AE(SDARY,SDOE,.SDLINE,.SDTOT,.SDONE)
- +8 QUIT
- +9 ;
- AE(SDARY,SDOE,SDLINE,SDTOT,SDONE) ; -- add/edits
- +1 NEW SDOE0,SDT,DFN,SDVIEN,CPTS,SDCNT,SDVCPT0,SDVCPT,SDSCD0,X
- +2 SET SDOE0=$GET(^SCE(+SDOE,0))
- +3 SET SDT=+SDOE0
- +4 SET DFN=+$PIECE(SDOE0,"^",2)
- +5 SET SDSC=+$PIECE(SDOE0,U,3)
- +6 SET SDCL=+$PIECE(SDOE0,U,4)
- +7 SET SDVIEN=+$PIECE(SDOE0,U,5)
- +8 ;
- +9 ; -- quit if visit already processed
- +10 if $DATA(SDONE(SDVIEN))
- GOTO AEQ
- +11 ;
- +12 SET SDSCD0=$GET(^DIC(40.7,SDSC,0))
- +13 SET SDLINE=SDLINE+1
- +14 DO SET(SDARY,SDLINE,$PIECE(SDSCD0,"^",2)_" "_$EXTRACT($PIECE(SDSCD0,"^"),1,30),5,"","","","","",.SDTOT)
- +15 ;
- +16 ; -- get cpts and loop
- +17 DO GETCPT^SDOE(SDOE,"CPTS")
- +18 SET (SDCNT,SDVCPT)=0
- +19 NEW MODINFO,MODPTR,MODTEXT,PTR,MODCODE,CPTINFO,ICPTVDT
- +20 FOR
- SET SDVCPT=+$ORDER(CPTS(SDVCPT))
- if 'SDVCPT
- QUIT
- Begin DoDot:1
- +21 ; S SDVCPT0=$G(CPTS(SDVCPT))
- +22 ; S SDCNT=SDCNT+1
- +23 SET SDLINE=SDLINE+1
- +24 DO SET(SDARY,SDLINE,"Procedure(s):",12,"","","","","",.SDTOT)
- +25 ;
- +26 ; IF $D(^ICPT(+SDVCPT0,0)) S X=^(0) D
- +27 ; N CPTINFO
- +28 SET ICPTVDT=$SELECT($PIECE(CPTS(SDVCPT),"^",3)'="":$$GET1^DIQ(9000010,$PIECE(CPTS(SDVCPT),"^",3),.01,"I"),1:"")
- +29 SET CPTINFO=$$CPT^ICPTCOD(+$GET(CPTS(SDVCPT)),ICPTVDT,1)
- +30 if CPTINFO>0
- SET X=$PIECE(CPTINFO,"^",2,99)
- SET X=$PIECE(X,"^")_" x "_$PIECE($GET(CPTS(SDVCPT)),"^",16)_" "_$PIECE(X,"^",2)
- +31 if CPTINFO'>0
- SET X="Procedure not defined"
- +32 ;
- +33 DO SET(SDARY,SDLINE,$EXTRACT(X,1,40),27,"","","","","",.SDTOT)
- +34 ;
- +35 ;Retrieve Procedure (CPT) Codes and associated Modifiers
- +36 SET PTR=0
- +37 FOR
- SET PTR=+$ORDER(CPTS(SDVCPT,1,PTR))
- if 'PTR
- QUIT
- Begin DoDot:2
- +38 SET MODPTR=$GET(CPTS(SDVCPT,1,PTR,0))
- +39 if 'MODPTR
- QUIT
- +40 SET MODINFO=$$MOD^ICPTMOD(MODPTR,"I",ICPTVDT,1)
- +41 if MODINFO'>0
- QUIT
- +42 SET MODCODE="-"_$PIECE(MODINFO,"^",2)
- +43 SET MODTEXT=$PIECE(MODINFO,"^",3)
- +44 SET SDLINE=SDLINE+1
- +45 DO SET(SDARY,SDLINE,MODCODE,29,"","","","","",.SDTOT)
- +46 DO SET(SDARY,SDLINE,MODTEXT,38,"","","","","",.SDTOT)
- +47 QUIT
- End DoDot:2
- End DoDot:1
- +48 ;
- +49 ; -- set indicator that visit was processed
- +50 SET SDONE(SDVIEN)=""
- AEQ QUIT
- +1 ;
- SET(SDARY,LINE,TEXT,COL,ON,OFF,SDSUB,SDCNT,SDATA,SDTOT) ; -- set display array
- +1 NEW X
- +2 if LINE>SDTOT
- SET SDTOT=LINE
- +3 SET X=$SELECT($DATA(^TMP(SDARY,$JOB,LINE,0)):^(0),1:"")
- +4 SET ^TMP(SDARY,$JOB,LINE,0)=$$SETSTR^VALM1(TEXT,X,COL,$LENGTH(TEXT))
- +5 if $GET(ON)]""!($GET(OFF)]"")
- DO CNTRL^VALM10(LINE,COL,$LENGTH(TEXT),$GET(ON),$GET(OFF))
- +6 if $GET(SDSUB)]""
- SET ^TMP("SDCOIDX",$JOB,SDSUB,SDCNT,SDLINE)=SDATA
- SET ^TMP("SDCOIDX",$JOB,SDSUB,0)=SDCNT
- +7 QUIT
- DXFTXT(DXTXT,DXARY) ; -- formatted diagnosis text
- +1 NEW DIWL,DIWR,X
- +2 KILL ^UTILITY($JOB,"W"),DXARY
- +3 SET DIWL=1
- SET DIWR=26
- SET X=$$SENTENCE^XLFSTR(DXTXT)
- +4 DO ^DIWP
- +5 SET X=""
- +6 FOR
- SET X=$ORDER(^UTILITY($JOB,"W",1,X))
- if X=""
- QUIT
- Begin DoDot:1
- +7 SET DXARY(X)=$GET(^UTILITY($JOB,"W",1,X,0))
- End DoDot:1
- +8 KILL ^UTILITY($JOB,"W")
- +9 QUIT