source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDPPADD1.m@ 824

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

initial load of WorldVistAEHR
File size: 3.3 KB
RevLine 
[613]1SDPPADD1 ;ALB/CAW - Patient Profile - Add/Edits ; 10/26/99 1:55pm
2 ;;5.3;Scheduling;**2,6,140,132,180**;Aug 13, 1993
3 ;
4EN1 ; Set up variables
5 N SDPPBEG,SDPPEND,SDPPQ
6 S SDPPBEG=$S($G(SDBEG):SDBEG,$G(SDBD):SDBD,1:2850101)
7 S SDPPEND=$S($G(SDEND):SDEND,1:SDED)
8 D OPEN^SDQ(.SDPPQ)
9 D INDEX^SDQ(.SDPPQ,"PATIENT/DATE","SET")
10 D PAT^SDQ(.SDPPQ,DFN,"SET")
11 D DATE^SDQ(.SDPPQ,SDPPBEG,SDPPEND,"SET")
12 D SCANCB^SDQ(.SDPPQ,"D CB^SDPPADD1(Y,Y0,.SDSTOP)","SET")
13 D ACTIVE^SDQ(.SDPPQ,"TRUE","SET")
14 D SCAN^SDQ(.SDPPQ,"BACKWARD")
15 D CLOSE^SDQ(.SDPPQ)
16 Q
17 ;
18CB(SDOE,SDOE0,SDSTOP) ; -- callback
19 IF $P(SDOE0,U,8)'=2 G CBQ ; -- use only if stop addition type
20 ;
21 IF $D(SDY),$P(SDOE0,U,3)'=SDY G CBQ ; -- check for specific stop code
22 ;
23 N SDPPCPT,SDVCPT,SDVCPT0,SDDT,SDIV,SDDV,SDFST,SDSEC,X,SDOPE
24 S SDFST=16,SDSEC=58
25 D GETCPT^SDOE(SDOE,"SDPPCPT")
26 ;
27 ; Date/Time and Last Edited By
28 S X="",X=$$SETSTR^VALM1("Date/Time:",X,5,10)
29 S X=$$SETSTR^VALM1($TR($$FMTE^XLFDT(+SDOE0,"5F")," ","0"),X,SDFST,24)
30 S X=$$SETSTR^VALM1("Last Edited By:",X,42,15)
31 S X=$$SETSTR^VALM1($P($G(^VA(200,+$P(SDOE0,U,99),0)),U),X,SDSEC,23)
32 D SET(X)
33 ;
34 ; Stop Code and Appt. Type
35 S X="",X=$$SETSTR^VALM1("Stop Code:",X,5,10)
36 S X=$$SETSTR^VALM1($P($G(^DIC(40.7,+$P(SDOE0,U,3),0)),U),X,SDFST,24)
37 S X=$$SETSTR^VALM1("Appt. Type:",X,46,11)
38 S X=$$SETSTR^VALM1($P($G(^SD(409.1,+$P(SDOE0,U,10),0)),U),X,SDSEC,23)
39 D SET(X)
40 ;
41 ; Associated Clinic and Eligibility for Visit
42 S X="",X=$$SETSTR^VALM1("Assoc. Clinic:",X,1,14)
43 S X=$$SETSTR^VALM1($P($G(^SC(+$P(SDOE0,U,4),0)),U),X,SDFST,24)
44 S X=$$SETSTR^VALM1("Elig. for Visit:",X,41,16)
45 S X=$$SETSTR^VALM1($P($G(^DIC(8,+$P(SDOE0,U,13),0)),U),X,SDSEC,23)
46 D SET(X)
47 ;
48 ;*** Retrieve Procedures (CPT codes)***
49 I $D(SDPPCPT) D
50 . N CPTINFO,MODINFO,MODCODE,MODPTR,PTR
51 . S X=""
52 .; S X=$$SETSTR^VALM1("Procedure(s): ",X,2,14)
53 . S SDVCPT=0
54 . F S SDVCPT=$O(SDPPCPT(SDVCPT)) Q:'SDVCPT D
55 . . S X=$$SETSTR^VALM1("Procedure(s): ",X,2,14)
56 . .; S SDVCPT0=SDPPCPT(SDVCPT)
57 . .; S:X="" X=$$SETSTR^VALM1(" ",X,2,14)
58 . .; S X=X_$P($G(^ICPT(+SDVCPT0,0)),U)_" x "_+$P(SDVCPT0,U,16)
59 . . S CPTINFO=$$CPT^ICPTCOD(+$G(SDPPCPT(SDVCPT)),,1)
60 . . Q:CPTINFO'>0
61 . . S X=X_$P(CPTINFO,"^",2)_" x "_$P($G(SDPPCPT(SDVCPT)),"^",16)_" "_$P(CPTINFO,"^",3)
62 . . S:X="" X=$$SETSTR^VALM1(" ",X,2,14)
63 . . ;S:$O(SDPPCPT(SDVCPT)) X=X_", "
64 . .; IF $L(X)>(IOM-10) D SET(X) S X=""
65 . . D SET(X) S X=""
66 . .;
67 . .;Retrieve Procedure (CPT) Codes and associated Modifiers
68 . . S PTR=0
69 . . F S PTR=$O(SDPPCPT(SDVCPT,1,PTR)) Q:'PTR D
70 . . . S MODPTR=$G(SDPPCPT(SDVCPT,1,PTR,0))
71 . . . S MODINFO=$$MOD^ICPTMOD(MODPTR,"I",,1)
72 . . . Q:MODINFO'>0
73 . . . S MODTEXT=$P(MODINFO,"^",3)
74 . . . S MODCODE="-"_$P(MODINFO,"^",2)
75 . . . S X=$$SETSTR^VALM1(MODCODE,X,18,21)
76 . . . S X=$$SETSTR^VALM1(MODTEXT,X,27,45)
77 . . . D SET(X) S X=""
78 . D:X]"" SET(X)
79 ;
80 S X=""
81 S SDOPE=$S($P(SDOE0,U,6):$P(SDOE0,U,6),1:SDOE)
82 S SDSTATUS=$P($G(^SD(409.63,+$P($G(^SCE(SDOPE,0)),U,12),0)),U)
83 S X=$$SETSTR^VALM1("Status:",X,7,13)
84 S X=$$SETSTR^VALM1(SDSTATUS,X,SDFST,24)
85 ;
86 S SDIV=+$P(SDOE0,U,11)
87 I SDIV D
88 . S SDDV=$P($G(^DG(40.8,SDIV,0)),U)
89 . S X=$$SETSTR^VALM1("Division:",X,48,15)
90 . S X=$$SETSTR^VALM1(SDDV,X,SDSEC,23)
91 D:X'="" SET(X)
92 D SET("")
93CBQ Q
94 ;
95SET(X) ; Set in ^TMP global for display
96 ;
97 S SDLN=SDLN+1,^TMP("SDPPALL",$J,SDLN,0)=X
98 Q
Note: See TracBrowser for help on using the repository browser.