SDPPADD1 ;ALB/CAW - Patient Profile - Add/Edits ; 10/26/99 1:55pm
;;5.3;Scheduling;**2,6,140,132,180**;Aug 13, 1993
;
EN1 ; Set up variables
N SDPPBEG,SDPPEND,SDPPQ
S SDPPBEG=$S($G(SDBEG):SDBEG,$G(SDBD):SDBD,1:2850101)
S SDPPEND=$S($G(SDEND):SDEND,1:SDED)
D OPEN^SDQ(.SDPPQ)
D INDEX^SDQ(.SDPPQ,"PATIENT/DATE","SET")
D PAT^SDQ(.SDPPQ,DFN,"SET")
D DATE^SDQ(.SDPPQ,SDPPBEG,SDPPEND,"SET")
D SCANCB^SDQ(.SDPPQ,"D CB^SDPPADD1(Y,Y0,.SDSTOP)","SET")
D ACTIVE^SDQ(.SDPPQ,"TRUE","SET")
D SCAN^SDQ(.SDPPQ,"BACKWARD")
D CLOSE^SDQ(.SDPPQ)
Q
;
CB(SDOE,SDOE0,SDSTOP) ; -- callback
IF $P(SDOE0,U,8)'=2 G CBQ ; -- use only if stop addition type
;
IF $D(SDY),$P(SDOE0,U,3)'=SDY G CBQ ; -- check for specific stop code
;
N SDPPCPT,SDVCPT,SDVCPT0,SDDT,SDIV,SDDV,SDFST,SDSEC,X,SDOPE
S SDFST=16,SDSEC=58
D GETCPT^SDOE(SDOE,"SDPPCPT")
;
; Date/Time and Last Edited By
S X="",X=$$SETSTR^VALM1("Date/Time:",X,5,10)
S X=$$SETSTR^VALM1($TR($$FMTE^XLFDT(+SDOE0,"5F")," ","0"),X,SDFST,24)
S X=$$SETSTR^VALM1("Last Edited By:",X,42,15)
S X=$$SETSTR^VALM1($P($G(^VA(200,+$P(SDOE0,U,99),0)),U),X,SDSEC,23)
D SET(X)
;
; Stop Code and Appt. Type
S X="",X=$$SETSTR^VALM1("Stop Code:",X,5,10)
S X=$$SETSTR^VALM1($P($G(^DIC(40.7,+$P(SDOE0,U,3),0)),U),X,SDFST,24)
S X=$$SETSTR^VALM1("Appt. Type:",X,46,11)
S X=$$SETSTR^VALM1($P($G(^SD(409.1,+$P(SDOE0,U,10),0)),U),X,SDSEC,23)
D SET(X)
;
; Associated Clinic and Eligibility for Visit
S X="",X=$$SETSTR^VALM1("Assoc. Clinic:",X,1,14)
S X=$$SETSTR^VALM1($P($G(^SC(+$P(SDOE0,U,4),0)),U),X,SDFST,24)
S X=$$SETSTR^VALM1("Elig. for Visit:",X,41,16)
S X=$$SETSTR^VALM1($P($G(^DIC(8,+$P(SDOE0,U,13),0)),U),X,SDSEC,23)
D SET(X)
;
;*** Retrieve Procedures (CPT codes)***
I $D(SDPPCPT) D
. N CPTINFO,MODINFO,MODCODE,MODPTR,PTR
. S X=""
.; S X=$$SETSTR^VALM1("Procedure(s): ",X,2,14)
. S SDVCPT=0
. F S SDVCPT=$O(SDPPCPT(SDVCPT)) Q:'SDVCPT D
. . S X=$$SETSTR^VALM1("Procedure(s): ",X,2,14)
. .; S SDVCPT0=SDPPCPT(SDVCPT)
. .; S:X="" X=$$SETSTR^VALM1(" ",X,2,14)
. .; S X=X_$P($G(^ICPT(+SDVCPT0,0)),U)_" x "_+$P(SDVCPT0,U,16)
. . S CPTINFO=$$CPT^ICPTCOD(+$G(SDPPCPT(SDVCPT)),,1)
. . Q:CPTINFO'>0
. . S X=X_$P(CPTINFO,"^",2)_" x "_$P($G(SDPPCPT(SDVCPT)),"^",16)_" "_$P(CPTINFO,"^",3)
. . S:X="" X=$$SETSTR^VALM1(" ",X,2,14)
. . ;S:$O(SDPPCPT(SDVCPT)) X=X_", "
. .; IF $L(X)>(IOM-10) D SET(X) S X=""
. . D SET(X) S X=""
. .;
. .;Retrieve Procedure (CPT) Codes and associated Modifiers
. . S PTR=0
. . F S PTR=$O(SDPPCPT(SDVCPT,1,PTR)) Q:'PTR D
. . . S MODPTR=$G(SDPPCPT(SDVCPT,1,PTR,0))
. . . S MODINFO=$$MOD^ICPTMOD(MODPTR,"I",,1)
. . . Q:MODINFO'>0
. . . S MODTEXT=$P(MODINFO,"^",3)
. . . S MODCODE="-"_$P(MODINFO,"^",2)
. . . S X=$$SETSTR^VALM1(MODCODE,X,18,21)
. . . S X=$$SETSTR^VALM1(MODTEXT,X,27,45)
. . . D SET(X) S X=""
. D:X]"" SET(X)
;
S X=""
S SDOPE=$S($P(SDOE0,U,6):$P(SDOE0,U,6),1:SDOE)
S SDSTATUS=$P($G(^SD(409.63,+$P($G(^SCE(SDOPE,0)),U,12),0)),U)
S X=$$SETSTR^VALM1("Status:",X,7,13)
S X=$$SETSTR^VALM1(SDSTATUS,X,SDFST,24)
;
S SDIV=+$P(SDOE0,U,11)
I SDIV D
. S SDDV=$P($G(^DG(40.8,SDIV,0)),U)
. S X=$$SETSTR^VALM1("Division:",X,48,15)
. S X=$$SETSTR^VALM1(SDDV,X,SDSEC,23)
D:X'="" SET(X)
D SET("")
CBQ Q
;
SET(X) ; Set in ^TMP global for display
;
S SDLN=SDLN+1,^TMP("SDPPALL",$J,SDLN,0)=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDPPADD1 3428 printed Apr 09, 2024@22:04:28 Page 2
SDPPADD1 ;ALB/CAW - Patient Profile - Add/Edits ; 10/26/99 1:55pm
+1 ;;5.3;Scheduling;**2,6,140,132,180**;Aug 13, 1993
+2 ;
EN1 ; Set up variables
+1 NEW SDPPBEG,SDPPEND,SDPPQ
+2 SET SDPPBEG=$SELECT($GET(SDBEG):SDBEG,$GET(SDBD):SDBD,1:2850101)
+3 SET SDPPEND=$SELECT($GET(SDEND):SDEND,1:SDED)
+4 DO OPEN^SDQ(.SDPPQ)
+5 DO INDEX^SDQ(.SDPPQ,"PATIENT/DATE","SET")
+6 DO PAT^SDQ(.SDPPQ,DFN,"SET")
+7 DO DATE^SDQ(.SDPPQ,SDPPBEG,SDPPEND,"SET")
+8 DO SCANCB^SDQ(.SDPPQ,"D CB^SDPPADD1(Y,Y0,.SDSTOP)","SET")
+9 DO ACTIVE^SDQ(.SDPPQ,"TRUE","SET")
+10 DO SCAN^SDQ(.SDPPQ,"BACKWARD")
+11 DO CLOSE^SDQ(.SDPPQ)
+12 QUIT
+13 ;
CB(SDOE,SDOE0,SDSTOP) ; -- callback
+1 ; -- use only if stop addition type
IF $PIECE(SDOE0,U,8)'=2
GOTO CBQ
+2 ;
+3 ; -- check for specific stop code
IF $DATA(SDY)
IF $PIECE(SDOE0,U,3)'=SDY
GOTO CBQ
+4 ;
+5 NEW SDPPCPT,SDVCPT,SDVCPT0,SDDT,SDIV,SDDV,SDFST,SDSEC,X,SDOPE
+6 SET SDFST=16
SET SDSEC=58
+7 DO GETCPT^SDOE(SDOE,"SDPPCPT")
+8 ;
+9 ; Date/Time and Last Edited By
+10 SET X=""
SET X=$$SETSTR^VALM1("Date/Time:",X,5,10)
+11 SET X=$$SETSTR^VALM1($TRANSLATE($$FMTE^XLFDT(+SDOE0,"5F")," ","0"),X,SDFST,24)
+12 SET X=$$SETSTR^VALM1("Last Edited By:",X,42,15)
+13 SET X=$$SETSTR^VALM1($PIECE($GET(^VA(200,+$PIECE(SDOE0,U,99),0)),U),X,SDSEC,23)
+14 DO SET(X)
+15 ;
+16 ; Stop Code and Appt. Type
+17 SET X=""
SET X=$$SETSTR^VALM1("Stop Code:",X,5,10)
+18 SET X=$$SETSTR^VALM1($PIECE($GET(^DIC(40.7,+$PIECE(SDOE0,U,3),0)),U),X,SDFST,24)
+19 SET X=$$SETSTR^VALM1("Appt. Type:",X,46,11)
+20 SET X=$$SETSTR^VALM1($PIECE($GET(^SD(409.1,+$PIECE(SDOE0,U,10),0)),U),X,SDSEC,23)
+21 DO SET(X)
+22 ;
+23 ; Associated Clinic and Eligibility for Visit
+24 SET X=""
SET X=$$SETSTR^VALM1("Assoc. Clinic:",X,1,14)
+25 SET X=$$SETSTR^VALM1($PIECE($GET(^SC(+$PIECE(SDOE0,U,4),0)),U),X,SDFST,24)
+26 SET X=$$SETSTR^VALM1("Elig. for Visit:",X,41,16)
+27 SET X=$$SETSTR^VALM1($PIECE($GET(^DIC(8,+$PIECE(SDOE0,U,13),0)),U),X,SDSEC,23)
+28 DO SET(X)
+29 ;
+30 ;*** Retrieve Procedures (CPT codes)***
+31 IF $DATA(SDPPCPT)
Begin DoDot:1
+32 NEW CPTINFO,MODINFO,MODCODE,MODPTR,PTR
+33 SET X=""
+34 ; S X=$$SETSTR^VALM1("Procedure(s): ",X,2,14)
+35 SET SDVCPT=0
+36 FOR
SET SDVCPT=$ORDER(SDPPCPT(SDVCPT))
if 'SDVCPT
QUIT
Begin DoDot:2
+37 SET X=$$SETSTR^VALM1("Procedure(s): ",X,2,14)
+38 ; S SDVCPT0=SDPPCPT(SDVCPT)
+39 ; S:X="" X=$$SETSTR^VALM1(" ",X,2,14)
+40 ; S X=X_$P($G(^ICPT(+SDVCPT0,0)),U)_" x "_+$P(SDVCPT0,U,16)
+41 SET CPTINFO=$$CPT^ICPTCOD(+$GET(SDPPCPT(SDVCPT)),,1)
+42 if CPTINFO'>0
QUIT
+43 SET X=X_$PIECE(CPTINFO,"^",2)_" x "_$PIECE($GET(SDPPCPT(SDVCPT)),"^",16)_" "_$PIECE(CPTINFO,"^",3)
+44 if X=""
SET X=$$SETSTR^VALM1(" ",X,2,14)
+45 ;S:$O(SDPPCPT(SDVCPT)) X=X_", "
+46 ; IF $L(X)>(IOM-10) D SET(X) S X=""
+47 DO SET(X)
SET X=""
+48 ;
+49 ;Retrieve Procedure (CPT) Codes and associated Modifiers
+50 SET PTR=0
+51 FOR
SET PTR=$ORDER(SDPPCPT(SDVCPT,1,PTR))
if 'PTR
QUIT
Begin DoDot:3
+52 SET MODPTR=$GET(SDPPCPT(SDVCPT,1,PTR,0))
+53 SET MODINFO=$$MOD^ICPTMOD(MODPTR,"I",,1)
+54 if MODINFO'>0
QUIT
+55 SET MODTEXT=$PIECE(MODINFO,"^",3)
+56 SET MODCODE="-"_$PIECE(MODINFO,"^",2)
+57 SET X=$$SETSTR^VALM1(MODCODE,X,18,21)
+58 SET X=$$SETSTR^VALM1(MODTEXT,X,27,45)
+59 DO SET(X)
SET X=""
End DoDot:3
End DoDot:2
+60 if X]""
DO SET(X)
End DoDot:1
+61 ;
+62 SET X=""
+63 SET SDOPE=$SELECT($PIECE(SDOE0,U,6):$PIECE(SDOE0,U,6),1:SDOE)
+64 SET SDSTATUS=$PIECE($GET(^SD(409.63,+$PIECE($GET(^SCE(SDOPE,0)),U,12),0)),U)
+65 SET X=$$SETSTR^VALM1("Status:",X,7,13)
+66 SET X=$$SETSTR^VALM1(SDSTATUS,X,SDFST,24)
+67 ;
+68 SET SDIV=+$PIECE(SDOE0,U,11)
+69 IF SDIV
Begin DoDot:1
+70 SET SDDV=$PIECE($GET(^DG(40.8,SDIV,0)),U)
+71 SET X=$$SETSTR^VALM1("Division:",X,48,15)
+72 SET X=$$SETSTR^VALM1(SDDV,X,SDSEC,23)
End DoDot:1
+73 if X'=""
DO SET(X)
+74 DO SET("")
CBQ QUIT
+1 ;
SET(X) ; Set in ^TMP global for display
+1 ;
+2 SET SDLN=SDLN+1
SET ^TMP("SDPPALL",$JOB,SDLN,0)=X
+3 QUIT
