Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDCO0

SDCO0.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. EN(SDARY,SDOE,SDSTART,SDTOT) ;Entry point Called by Ck Out & Apt Mgr Exp Dis
  1. S SDTOT=0
  1. D CL(SDARY,SDOE,SDSTART,.SDTOT)
  1. D PR(SDARY,SDOE,SDSTART,.SDTOT)
  1. D DX(SDARY,SDOE,SDSTART,.SDTOT)
  1. I $P($G(^SCE(+SDOE,0)),"^",8)'=2 D SC(SDARY,SDOE,SDSTART,.SDTOT)
  1. Q
  1. ;
  1. CL(SDARY,SDOE,SDSTART,SDTOT) ;Build classification (Pg: 1 Row: SDSTART-SDSTART+7 Col: 1-80)
  1. N SDCLOEY,SDCNI,SDCNT,SDCTI,SDCTIS,SDCTS,SDEND,SDLINE,SDNA,SDVAL,X
  1. S SDLINE=SDSTART,SDEND=SDSTART+8
  1. D SET(SDARY,SDLINE," CLASSIFICATION ",5,IORVON,IORVOFF,"","","",.SDTOT)
  1. D CLASK^SDCO2(SDOE,.SDCLOEY)
  1. D SET(SDARY,SDLINE,"["_$S($D(SDCLOEY):"Required",1:"Not Required")_"]",24,"","","","","",.SDTOT)
  1. S SDCNT=0,SDCTIS=$$SEQ^SDCO21
  1. F SDCTS=1:1 S SDCTI=+$P(SDCTIS,",",SDCTS) Q:'SDCTI D
  1. .S SDCNT=SDCNT+1,SDLINE=SDLINE+1
  1. .S:$D(SDCLOEY(SDCTI)) SDVAL=$$VAL^SDCODD(SDCTI,$P(SDCLOEY(SDCTI),"^",2)),SDNA=+$P(SDCLOEY(SDCTI),"^",3)
  1. .S X=$S('$D(SDCLOEY(SDCTI)):"Not Applicable",$$COMDT^SDCOU(SDOE)&(SDVAL=""):"Not Applicable",SDVAL="":"Unanswered",1:SDVAL)
  1. .D SET(SDARY,SDLINE,SDCNT_" "_$J($P($G(^SD(409.41,SDCTI,0)),"^",6)_": ",32)_X,2,"","","CL",SDCNT,+$G(SDCLOEY(SDCTI))_"^"_SDCTI,.SDTOT)
  1. F SDLINE=SDLINE+1:1:SDEND D SET(SDARY,SDLINE,"",1,"","","","","",.SDTOT)
  1. Q
  1. ;
  1. PR(SDARY,SDOE,SDSTART,SDTOT) ;Build Provider (Pg: 1 Row: SDSTART+8-END Col: 1-40)
  1. N SDCNT,SDLINE,SDPR,SDVPRV
  1. S SDLINE=SDSTART+9
  1. D SET(SDARY,SDLINE," PROVIDER ",5,IORVON,IORVOFF,"","","",.SDTOT)
  1. D SET(SDARY,SDLINE,"["_$S($$PRASK^SDCO3(SDOE)=1:"Required",1:"Not Required")_"]",18,"","","","","",.SDTOT)
  1. ;
  1. ; -- get provider data
  1. D GETPRV^SDOE(SDOE,"SDPR")
  1. S (SDCNT,SDVPRV)=0
  1. F S SDVPRV=$O(SDPR(SDVPRV)) Q:'SDVPRV D
  1. . S SDCNT=SDCNT+1
  1. . S SDLINE=SDLINE+1
  1. . D SET(SDARY,SDLINE,SDCNT_" "_$$PR^SDCO31(+SDPR(SDVPRV)),2,"","","PR",SDCNT,SDVPRV_"^"_+SDPR(SDVPRV),.SDTOT)
  1. Q
  1. ;
  1. DX(SDARY,SDOE,SDSTART,SDTOT) ;Build Diagnosis (Pg: 1 Row: SDSTART+8-END Col: 42-80)
  1. N SDCNT,SDDXS,SDDXD,SDVPOV,SDLINE,ICDVDT,IMPDT,DXARY,TXT,I
  1. S SDLINE=SDSTART+9
  1. D SET(SDARY,SDLINE," DIAGNOSIS ",45,IORVON,IORVOFF,"","","",.SDTOT)
  1. D SET(SDARY,SDLINE,"["_$S($$DXASK^SDCO4(SDOE)=1:"Required",1:"Not Required")_"]",59,"","","","","",.SDTOT)
  1. ;
  1. ; -- get dxs data
  1. D GETDX^SDOE(SDOE,"SDDXS")
  1. S (SDCNT,SDVPOV)=0
  1. S IMPDT=$$IMP^ICDEX(30)
  1. F S SDVPOV=$O(SDDXS(SDVPOV)) Q:'SDVPOV D
  1. . S SDCNT=SDCNT+1
  1. . S SDLINE=SDLINE+1
  1. . S ICDVDT=$S($P(SDDXS(SDVPOV),"^",3)'="":$$GET1^DIQ(9000010,$P(SDDXS(SDVPOV),"^",3),.01,"I"),1:"")
  1. . S SDDXD=$$DX^SDCO41(+SDDXS(SDVPOV),ICDVDT)
  1. . D SET(SDARY,SDLINE,SDCNT_" "_$P(SDDXD,"^"),42,"","","","","",.SDTOT)
  1. . I ICDVDT<IMPDT D Q
  1. . . D SET(SDARY,SDLINE,$P(SDDXD,"^",2),55,"","","DX",SDCNT,SDVPOV_"^"_+SDDXS(SDVPOV),.SDTOT)
  1. . D DXFTXT($P(SDDXD,"^",2),.DXARY) S I="" F S I=$O(DXARY(I)) Q:I="" S TXT=DXARY(I) D
  1. . . I I=1 D SET(SDARY,SDLINE,TXT,55,"","","DX",SDCNT,SDVPOV_"^"_+SDDXS(SDVPOV),.SDTOT) Q
  1. . . S SDLINE=SDLINE+1 D SET(SDARY,SDLINE,TXT,55,"","","","","",.SDTOT)
  1. Q
  1. ;
  1. SC(SDARY,SDOEP,SDSTART,SDTOT) ;Build Stop Codes (Pg: 2 Row: SDTOT+1 Col: 1-80)
  1. N SDLINE,SDONE
  1. F SDLINE=SDTOT+1:1:SDSTART+VALM("LINES")+1 D SET(SDARY,SDLINE,"",1,"","","","","",.SDTOT)
  1. D SET(SDARY,SDLINE," STOP CODES ",5,IORVON,IORVOFF,"","","",.SDTOT)
  1. D SET(SDARY,SDLINE,"[Stop Codes Not Required / Procedures Required]",28,"","","","","",.SDTOT)
  1. D AE(SDARY,SDOEP,.SDLINE,.SDTOT,.SDONE)
  1. S SDOE=0
  1. F S SDOE=$O(^SCE("APAR",SDOEP,SDOE)) Q:'SDOE D AE(SDARY,SDOE,.SDLINE,.SDTOT,.SDONE)
  1. Q
  1. ;
  1. AE(SDARY,SDOE,SDLINE,SDTOT,SDONE) ; -- add/edits
  1. N SDOE0,SDT,DFN,SDVIEN,CPTS,SDCNT,SDVCPT0,SDVCPT,SDSCD0,X
  1. S SDOE0=$G(^SCE(+SDOE,0))
  1. S SDT=+SDOE0
  1. S DFN=+$P(SDOE0,"^",2)
  1. S SDSC=+$P(SDOE0,U,3)
  1. S SDCL=+$P(SDOE0,U,4)
  1. S SDVIEN=+$P(SDOE0,U,5)
  1. ;
  1. ; -- quit if visit already processed
  1. G:$D(SDONE(SDVIEN)) AEQ
  1. ;
  1. S SDSCD0=$G(^DIC(40.7,SDSC,0))
  1. S SDLINE=SDLINE+1
  1. D SET(SDARY,SDLINE,$P(SDSCD0,"^",2)_" "_$E($P(SDSCD0,"^"),1,30),5,"","","","","",.SDTOT)
  1. ;
  1. ; -- get cpts and loop
  1. D GETCPT^SDOE(SDOE,"CPTS")
  1. S (SDCNT,SDVCPT)=0
  1. N MODINFO,MODPTR,MODTEXT,PTR,MODCODE,CPTINFO,ICPTVDT
  1. F S SDVCPT=+$O(CPTS(SDVCPT)) Q:'SDVCPT D
  1. .; S SDVCPT0=$G(CPTS(SDVCPT))
  1. .; S SDCNT=SDCNT+1
  1. . S SDLINE=SDLINE+1
  1. . D SET(SDARY,SDLINE,"Procedure(s):",12,"","","","","",.SDTOT)
  1. .;
  1. .; IF $D(^ICPT(+SDVCPT0,0)) S X=^(0) D
  1. .; N CPTINFO
  1. . S ICPTVDT=$S($P(CPTS(SDVCPT),"^",3)'="":$$GET1^DIQ(9000010,$P(CPTS(SDVCPT),"^",3),.01,"I"),1:"")
  1. . S CPTINFO=$$CPT^ICPTCOD(+$G(CPTS(SDVCPT)),ICPTVDT,1)
  1. . S:CPTINFO>0 X=$P(CPTINFO,"^",2,99),X=$P(X,"^")_" x "_$P($G(CPTS(SDVCPT)),"^",16)_" "_$P(X,"^",2)
  1. . S:CPTINFO'>0 X="Procedure not defined"
  1. . ;
  1. . D SET(SDARY,SDLINE,$E(X,1,40),27,"","","","","",.SDTOT)
  1. . ;
  1. . ;Retrieve Procedure (CPT) Codes and associated Modifiers
  1. . S PTR=0
  1. . F S PTR=+$O(CPTS(SDVCPT,1,PTR)) Q:'PTR D
  1. . . S MODPTR=$G(CPTS(SDVCPT,1,PTR,0))
  1. . . Q:'MODPTR
  1. . . S MODINFO=$$MOD^ICPTMOD(MODPTR,"I",ICPTVDT,1)
  1. . . Q:MODINFO'>0
  1. . . S MODCODE="-"_$P(MODINFO,"^",2)
  1. . . S MODTEXT=$P(MODINFO,"^",3)
  1. . . S SDLINE=SDLINE+1
  1. . . D SET(SDARY,SDLINE,MODCODE,29,"","","","","",.SDTOT)
  1. . . D SET(SDARY,SDLINE,MODTEXT,38,"","","","","",.SDTOT)
  1. . . Q
  1. ;
  1. ; -- set indicator that visit was processed
  1. S SDONE(SDVIEN)=""
  1. AEQ Q
  1. ;
  1. SET(SDARY,LINE,TEXT,COL,ON,OFF,SDSUB,SDCNT,SDATA,SDTOT) ; -- set display array
  1. N X
  1. S:LINE>SDTOT SDTOT=LINE
  1. S X=$S($D(^TMP(SDARY,$J,LINE,0)):^(0),1:"")
  1. S ^TMP(SDARY,$J,LINE,0)=$$SETSTR^VALM1(TEXT,X,COL,$L(TEXT))
  1. D:$G(ON)]""!($G(OFF)]"") CNTRL^VALM10(LINE,COL,$L(TEXT),$G(ON),$G(OFF))
  1. S:$G(SDSUB)]"" ^TMP("SDCOIDX",$J,SDSUB,SDCNT,SDLINE)=SDATA,^TMP("SDCOIDX",$J,SDSUB,0)=SDCNT
  1. Q
  1. DXFTXT(DXTXT,DXARY) ; -- formatted diagnosis text
  1. N DIWL,DIWR,X
  1. K ^UTILITY($J,"W"),DXARY
  1. S DIWL=1,DIWR=26,X=$$SENTENCE^XLFSTR(DXTXT)
  1. D ^DIWP
  1. S X=""
  1. F S X=$O(^UTILITY($J,"W",1,X)) Q:X="" D
  1. . S DXARY(X)=$G(^UTILITY($J,"W",1,X,0))
  1. K ^UTILITY($J,"W")
  1. Q