- 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 Feb 19, 2025@00:26:08 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