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

SDPPADD1.m

Go to the documentation of this file.
  1. SDPPADD1 ;ALB/CAW - Patient Profile - Add/Edits ; 10/26/99 1:55pm
  1. ;;5.3;Scheduling;**2,6,140,132,180**;Aug 13, 1993
  1. ;
  1. EN1 ; Set up variables
  1. N SDPPBEG,SDPPEND,SDPPQ
  1. S SDPPBEG=$S($G(SDBEG):SDBEG,$G(SDBD):SDBD,1:2850101)
  1. S SDPPEND=$S($G(SDEND):SDEND,1:SDED)
  1. D OPEN^SDQ(.SDPPQ)
  1. D INDEX^SDQ(.SDPPQ,"PATIENT/DATE","SET")
  1. D PAT^SDQ(.SDPPQ,DFN,"SET")
  1. D DATE^SDQ(.SDPPQ,SDPPBEG,SDPPEND,"SET")
  1. D SCANCB^SDQ(.SDPPQ,"D CB^SDPPADD1(Y,Y0,.SDSTOP)","SET")
  1. D ACTIVE^SDQ(.SDPPQ,"TRUE","SET")
  1. D SCAN^SDQ(.SDPPQ,"BACKWARD")
  1. D CLOSE^SDQ(.SDPPQ)
  1. Q
  1. ;
  1. CB(SDOE,SDOE0,SDSTOP) ; -- callback
  1. IF $P(SDOE0,U,8)'=2 G CBQ ; -- use only if stop addition type
  1. ;
  1. IF $D(SDY),$P(SDOE0,U,3)'=SDY G CBQ ; -- check for specific stop code
  1. ;
  1. N SDPPCPT,SDVCPT,SDVCPT0,SDDT,SDIV,SDDV,SDFST,SDSEC,X,SDOPE
  1. S SDFST=16,SDSEC=58
  1. D GETCPT^SDOE(SDOE,"SDPPCPT")
  1. ;
  1. ; Date/Time and Last Edited By
  1. S X="",X=$$SETSTR^VALM1("Date/Time:",X,5,10)
  1. S X=$$SETSTR^VALM1($TR($$FMTE^XLFDT(+SDOE0,"5F")," ","0"),X,SDFST,24)
  1. S X=$$SETSTR^VALM1("Last Edited By:",X,42,15)
  1. S X=$$SETSTR^VALM1($P($G(^VA(200,+$P(SDOE0,U,99),0)),U),X,SDSEC,23)
  1. D SET(X)
  1. ;
  1. ; Stop Code and Appt. Type
  1. S X="",X=$$SETSTR^VALM1("Stop Code:",X,5,10)
  1. S X=$$SETSTR^VALM1($P($G(^DIC(40.7,+$P(SDOE0,U,3),0)),U),X,SDFST,24)
  1. S X=$$SETSTR^VALM1("Appt. Type:",X,46,11)
  1. S X=$$SETSTR^VALM1($P($G(^SD(409.1,+$P(SDOE0,U,10),0)),U),X,SDSEC,23)
  1. D SET(X)
  1. ;
  1. ; Associated Clinic and Eligibility for Visit
  1. S X="",X=$$SETSTR^VALM1("Assoc. Clinic:",X,1,14)
  1. S X=$$SETSTR^VALM1($P($G(^SC(+$P(SDOE0,U,4),0)),U),X,SDFST,24)
  1. S X=$$SETSTR^VALM1("Elig. for Visit:",X,41,16)
  1. S X=$$SETSTR^VALM1($P($G(^DIC(8,+$P(SDOE0,U,13),0)),U),X,SDSEC,23)
  1. D SET(X)
  1. ;
  1. ;*** Retrieve Procedures (CPT codes)***
  1. I $D(SDPPCPT) D
  1. . N CPTINFO,MODINFO,MODCODE,MODPTR,PTR
  1. . S X=""
  1. .; S X=$$SETSTR^VALM1("Procedure(s): ",X,2,14)
  1. . S SDVCPT=0
  1. . F S SDVCPT=$O(SDPPCPT(SDVCPT)) Q:'SDVCPT D
  1. . . S X=$$SETSTR^VALM1("Procedure(s): ",X,2,14)
  1. . .; S SDVCPT0=SDPPCPT(SDVCPT)
  1. . .; S:X="" X=$$SETSTR^VALM1(" ",X,2,14)
  1. . .; S X=X_$P($G(^ICPT(+SDVCPT0,0)),U)_" x "_+$P(SDVCPT0,U,16)
  1. . . S CPTINFO=$$CPT^ICPTCOD(+$G(SDPPCPT(SDVCPT)),,1)
  1. . . Q:CPTINFO'>0
  1. . . S X=X_$P(CPTINFO,"^",2)_" x "_$P($G(SDPPCPT(SDVCPT)),"^",16)_" "_$P(CPTINFO,"^",3)
  1. . . S:X="" X=$$SETSTR^VALM1(" ",X,2,14)
  1. . . ;S:$O(SDPPCPT(SDVCPT)) X=X_", "
  1. . .; IF $L(X)>(IOM-10) D SET(X) S X=""
  1. . . D SET(X) S X=""
  1. . .;
  1. . .;Retrieve Procedure (CPT) Codes and associated Modifiers
  1. . . S PTR=0
  1. . . F S PTR=$O(SDPPCPT(SDVCPT,1,PTR)) Q:'PTR D
  1. . . . S MODPTR=$G(SDPPCPT(SDVCPT,1,PTR,0))
  1. . . . S MODINFO=$$MOD^ICPTMOD(MODPTR,"I",,1)
  1. . . . Q:MODINFO'>0
  1. . . . S MODTEXT=$P(MODINFO,"^",3)
  1. . . . S MODCODE="-"_$P(MODINFO,"^",2)
  1. . . . S X=$$SETSTR^VALM1(MODCODE,X,18,21)
  1. . . . S X=$$SETSTR^VALM1(MODTEXT,X,27,45)
  1. . . . D SET(X) S X=""
  1. . D:X]"" SET(X)
  1. ;
  1. S X=""
  1. S SDOPE=$S($P(SDOE0,U,6):$P(SDOE0,U,6),1:SDOE)
  1. S SDSTATUS=$P($G(^SD(409.63,+$P($G(^SCE(SDOPE,0)),U,12),0)),U)
  1. S X=$$SETSTR^VALM1("Status:",X,7,13)
  1. S X=$$SETSTR^VALM1(SDSTATUS,X,SDFST,24)
  1. ;
  1. S SDIV=+$P(SDOE0,U,11)
  1. I SDIV D
  1. . S SDDV=$P($G(^DG(40.8,SDIV,0)),U)
  1. . S X=$$SETSTR^VALM1("Division:",X,48,15)
  1. . S X=$$SETSTR^VALM1(SDDV,X,SDSEC,23)
  1. D:X'="" SET(X)
  1. D SET("")
  1. CBQ Q
  1. ;
  1. SET(X) ; Set in ^TMP global for display
  1. ;
  1. S SDLN=SDLN+1,^TMP("SDPPALL",$J,SDLN,0)=X
  1. Q