source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDCO0.m@ 1416

Last change on this file since 1416 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.2 KB
Line 
1SDCO0 ;ALB/RMO - Build List Area - Check Out; 11 FEB 1993 10:00 am ; 10/27/99 12:56pm
2 ;;5.3;Scheduling;**20,44,132,180,351**;Aug 13, 1993
3 ;
4EN(SDARY,SDOE,SDSTART,SDTOT) ;Entry point Called by Ck Out & Apt Mgr Exp Dis
5 S SDTOT=0
6 D CL(SDARY,SDOE,SDSTART,.SDTOT)
7 D PR(SDARY,SDOE,SDSTART,.SDTOT)
8 D DX(SDARY,SDOE,SDSTART,.SDTOT)
9 I $P($G(^SCE(+SDOE,0)),"^",8)'=2 D SC(SDARY,SDOE,SDSTART,.SDTOT)
10 Q
11 ;
12CL(SDARY,SDOE,SDSTART,SDTOT) ;Build classification (Pg: 1 Row: SDSTART-SDSTART+7 Col: 1-80)
13 N SDCLOEY,SDCNI,SDCNT,SDCTI,SDCTIS,SDCTS,SDEND,SDLINE,SDNA,SDVAL,X
14 S SDLINE=SDSTART,SDEND=SDSTART+7
15 D SET(SDARY,SDLINE," CLASSIFICATION ",5,IORVON,IORVOFF,"","","",.SDTOT)
16 D CLASK^SDCO2(SDOE,.SDCLOEY)
17 D SET(SDARY,SDLINE,"["_$S($D(SDCLOEY):"Required",1:"Not Required")_"]",24,"","","","","",.SDTOT)
18 S SDCNT=0,SDCTIS=$$SEQ^SDCO21
19 F SDCTS=1:1 S SDCTI=+$P(SDCTIS,",",SDCTS) Q:'SDCTI D
20 .S SDCNT=SDCNT+1,SDLINE=SDLINE+1
21 .S:$D(SDCLOEY(SDCTI)) SDVAL=$$VAL^SDCODD(SDCTI,$P(SDCLOEY(SDCTI),"^",2)),SDNA=+$P(SDCLOEY(SDCTI),"^",3)
22 .S X=$S('$D(SDCLOEY(SDCTI)):"Not Applicable",$$COMDT^SDCOU(SDOE)&(SDVAL=""):"Not Applicable",SDVAL="":"Unanswered",1:SDVAL)
23 .D SET(SDARY,SDLINE,SDCNT_" "_$J($P($G(^SD(409.41,SDCTI,0)),"^",6)_": ",32)_X,2,"","","CL",SDCNT,+$G(SDCLOEY(SDCTI))_"^"_SDCTI,.SDTOT)
24 F SDLINE=SDLINE+1:1:SDEND D SET(SDARY,SDLINE,"",1,"","","","","",.SDTOT)
25 Q
26 ;
27PR(SDARY,SDOE,SDSTART,SDTOT) ;Build Provider (Pg: 1 Row: SDSTART+8-END Col: 1-40)
28 N SDCNT,SDLINE,SDPR,SDVPRV
29 S SDLINE=SDSTART+8
30 D SET(SDARY,SDLINE," PROVIDER ",5,IORVON,IORVOFF,"","","",.SDTOT)
31 D SET(SDARY,SDLINE,"["_$S($$PRASK^SDCO3(SDOE)=1:"Required",1:"Not Required")_"]",18,"","","","","",.SDTOT)
32 ;
33 ; -- get provider data
34 D GETPRV^SDOE(SDOE,"SDPR")
35 S (SDCNT,SDVPRV)=0
36 F S SDVPRV=$O(SDPR(SDVPRV)) Q:'SDVPRV D
37 . S SDCNT=SDCNT+1
38 . S SDLINE=SDLINE+1
39 . D SET(SDARY,SDLINE,SDCNT_" "_$$PR^SDCO31(+SDPR(SDVPRV)),2,"","","PR",SDCNT,SDVPRV_"^"_+SDPR(SDVPRV),.SDTOT)
40 Q
41 ;
42DX(SDARY,SDOE,SDSTART,SDTOT) ;Build Diagnosis (Pg: 1 Row: SDSTART+8-END Col: 42-80)
43 N SDCNT,SDDXS,SDDXD,SDVPOV,SDLINE,ICDVDT
44 S SDLINE=SDSTART+8
45 D SET(SDARY,SDLINE," DIAGNOSIS ",45,IORVON,IORVOFF,"","","",.SDTOT)
46 D SET(SDARY,SDLINE,"["_$S($$DXASK^SDCO4(SDOE)=1:"Required",1:"Not Required")_"]",59,"","","","","",.SDTOT)
47 ;
48 ; -- get dxs data
49 D GETDX^SDOE(SDOE,"SDDXS")
50 S (SDCNT,SDVPOV)=0
51 F S SDVPOV=$O(SDDXS(SDVPOV)) Q:'SDVPOV D
52 . S SDCNT=SDCNT+1
53 . S SDLINE=SDLINE+1
54 . S ICDVDT=$S($P(SDDXS(SDVPOV),"^",3)'="":$$GET1^DIQ(9000010,$P(SDDXS(SDVPOV),"^",3),.01,"I"),1:"")
55 . S SDDXD=$$DX^SDCO41(+SDDXS(SDVPOV),ICDVDT)
56 . D SET(SDARY,SDLINE,SDCNT_" "_$P(SDDXD,"^"),42,"","","","","",.SDTOT)
57 . D SET(SDARY,SDLINE,$P(SDDXD,"^",2),55,"","","DX",SDCNT,SDVPOV_"^"_+SDDXS(SDVPOV),.SDTOT)
58 Q
59 ;
60SC(SDARY,SDOEP,SDSTART,SDTOT) ;Build Stop Codes (Pg: 2 Row: SDTOT+1 Col: 1-80)
61 N SDLINE,SDONE
62 F SDLINE=SDTOT+1:1:SDSTART+VALM("LINES")+1 D SET(SDARY,SDLINE,"",1,"","","","","",.SDTOT)
63 D SET(SDARY,SDLINE," STOP CODES ",5,IORVON,IORVOFF,"","","",.SDTOT)
64 D SET(SDARY,SDLINE,"[Stop Codes Not Required / Procedures Required]",28,"","","","","",.SDTOT)
65 D AE(SDARY,SDOEP,.SDLINE,.SDTOT,.SDONE)
66 S SDOE=0
67 F S SDOE=$O(^SCE("APAR",SDOEP,SDOE)) Q:'SDOE D AE(SDARY,SDOE,.SDLINE,.SDTOT,.SDONE)
68 Q
69 ;
70AE(SDARY,SDOE,SDLINE,SDTOT,SDONE) ; -- add/edits
71 N SDOE0,SDT,DFN,SDVIEN,CPTS,SDCNT,SDVCPT0,SDVCPT,SDSCD0,X
72 S SDOE0=$G(^SCE(+SDOE,0))
73 S SDT=+SDOE0
74 S DFN=+$P(SDOE0,"^",2)
75 S SDSC=+$P(SDOE0,U,3)
76 S SDCL=+$P(SDOE0,U,4)
77 S SDVIEN=+$P(SDOE0,U,5)
78 ;
79 ; -- quit if visit already processed
80 G:$D(SDONE(SDVIEN)) AEQ
81 ;
82 S SDSCD0=$G(^DIC(40.7,SDSC,0))
83 S SDLINE=SDLINE+1
84 D SET(SDARY,SDLINE,$P(SDSCD0,"^",2)_" "_$E($P(SDSCD0,"^"),1,30),5,"","","","","",.SDTOT)
85 ;
86 ; -- get cpts and loop
87 D GETCPT^SDOE(SDOE,"CPTS")
88 S (SDCNT,SDVCPT)=0
89 N MODINFO,MODPTR,MODTEXT,PTR,MODCODE,CPTINFO,ICPTVDT
90 F S SDVCPT=+$O(CPTS(SDVCPT)) Q:'SDVCPT D
91 .; S SDVCPT0=$G(CPTS(SDVCPT))
92 .; S SDCNT=SDCNT+1
93 . S SDLINE=SDLINE+1
94 . D SET(SDARY,SDLINE,"Procedure(s):",12,"","","","","",.SDTOT)
95 .;
96 .; IF $D(^ICPT(+SDVCPT0,0)) S X=^(0) D
97 .; N CPTINFO
98 . S ICPTVDT=$S($P(CPTS(SDVCPT),"^",3)'="":$$GET1^DIQ(9000010,$P(CPTS(SDVCPT),"^",3),.01,"I"),1:"")
99 . S CPTINFO=$$CPT^ICPTCOD(+$G(CPTS(SDVCPT)),ICPTVDT,1)
100 . S:CPTINFO>0 X=$P(CPTINFO,"^",2,99),X=$P(X,"^")_" x "_$P($G(CPTS(SDVCPT)),"^",16)_" "_$P(X,"^",2)
101 . S:CPTINFO'>0 X="Procedure not defined"
102 . ;
103 . D SET(SDARY,SDLINE,$E(X,1,40),27,"","","","","",.SDTOT)
104 . ;
105 . ;Retrieve Procedure (CPT) Codes and associated Modifiers
106 . S PTR=0
107 . F S PTR=+$O(CPTS(SDVCPT,1,PTR)) Q:'PTR D
108 . . S MODPTR=$G(CPTS(SDVCPT,1,PTR,0))
109 . . Q:'MODPTR
110 . . S MODINFO=$$MOD^ICPTMOD(MODPTR,"I",ICPTVDT,1)
111 . . Q:MODINFO'>0
112 . . S MODCODE="-"_$P(MODINFO,"^",2)
113 . . S MODTEXT=$P(MODINFO,"^",3)
114 . . S SDLINE=SDLINE+1
115 . . D SET(SDARY,SDLINE,MODCODE,29,"","","","","",.SDTOT)
116 . . D SET(SDARY,SDLINE,MODTEXT,38,"","","","","",.SDTOT)
117 . . Q
118 ;
119 ; -- set indicator that visit was processed
120 S SDONE(SDVIEN)=""
121AEQ Q
122 ;
123SET(SDARY,LINE,TEXT,COL,ON,OFF,SDSUB,SDCNT,SDATA,SDTOT) ; -- set display array
124 N X
125 S:LINE>SDTOT SDTOT=LINE
126 S X=$S($D(^TMP(SDARY,$J,LINE,0)):^(0),1:"")
127 S ^TMP(SDARY,$J,LINE,0)=$$SETSTR^VALM1(TEXT,X,COL,$L(TEXT))
128 D:$G(ON)]""!($G(OFF)]"") CNTRL^VALM10(LINE,COL,$L(TEXT),$G(ON),$G(OFF))
129 S:$G(SDSUB)]"" ^TMP("SDCOIDX",$J,SDSUB,SDCNT,SDLINE)=SDATA,^TMP("SDCOIDX",$J,SDSUB,0)=SDCNT
130 Q
Note: See TracBrowser for help on using the repository browser.