- SDAM3 ;MJK/ALB - Appt Mgt (Clinic) ; 4/21/05 12:23pm
- ;;5.3;Scheduling;**63,189,380,478,492,1003,1015**;Aug 13, 1993;Build 21
- ;IHS/ANMC/LJF 8/18/2000 added warnings that clinic was inactivated
- ; 7/12/2001 changed default list to all appts
- ;IHS/ITSC/LJF 6/17/2005 PATCH 1003 allow appt threshold of zero
- ;
- INIT ; -- get init clinic appt data
- ; input: SDCLN := ifn of pat
- ; output: ^TMP("SDAM" := appt array
- ;
- I '$$ACTV^BSDU(SDCLN,DT) D ;IHS/ANMC/LJF 8/18/2000
- . S X="** Inactivated on "_$$INACTVDT^BSDU(SDCLN)_" **" ;IHS/ANMC/LJF 8/18/2000
- . D EN^DDIOL(.X) ;IHS/ANMC/LJF 8/18/2000
- ;
- ;IHS/ITSC/LJF 6/17/2005 PATCH 1003
- ;S X=$P($G(^DG(43,1,"SCLR")),U,12),SDPRD=$S(X:X,1:2)
- S X=$P($G(^DG(43,1,"SCLR")),U,12),SDPRD=$S(X]"":X,1:2)
- S X1=DT,X2=-SDPRD D C^%DTC S VALMB=X D RANGE^VALM11
- I '$D(VALMBEG) S VALMQUIT="" G INITQ
- S SDBEG=VALMBEG,SDEND=VALMEND
- D CHGCAP^VALM("NAME","Patient")
- ;IHS/ANMC/LJF 7/12/2001 default to all appts
- ;S X="NO ACTION TAKEN" D LIST^SDAM
- S X="ALL" D LIST^SDAM
- ;IHS/ANMC/LJF 7/12/2001 end of changes
- ;
- INITQ K VALMB,VALMBEG,VALMEND Q
- ;
- BLD ; -- scan apts
- N VA,SDAMDD,SDNAME,SDMAX,SDLARGE,DFN,SDCL,BL,XC,XW,AC,AW,TC,TW,NC,NW,SC,SW,SDT,SDDA ; done for speed see INIT^SDAM10
- D INIT^SDAM10
- F SDT=SDBEG:0 S SDT=$O(^SC(SDCLN,"S",SDT)) Q:'SDT!($P(SDT,".",1)>SDEND) D
- .F SDDA=0:0 S SDDA=$O(^SC(SDCLN,"S",SDT,1,SDDA)) Q:'SDDA S CNSTLNK=$P($G(^SC(SDCLN,"S",SDT,1,SDDA,"CONS")),U),CSTAT="" S:CNSTLNK'="" CSTAT=$P($G(^GMR(123,CNSTLNK,0)),U,12) D ;SD/478
- ..I $D(^SC(SDCLN,"S",SDT,1,SDDA,0)) S DFN=+^(0) D ;SD/492
- ...N NDX,DA,FND ;SD/492
- ...S (FND,NDX)="" ;SD/492
- ...F S NDX=$O(^TMP("SDAMIDX",$J,NDX)) Q:NDX="" D Q:FND ;SD/492
- ....S DA=^TMP("SDAMIDX",$J,NDX) ;SD/492
- ....I $P(DA,U,2)=DFN,$P(DA,U,3)=SDT,$P(DA,U,4)=SDCLN S FND=1 ;SD/492
- ...Q:FND ;SD/492
- ...D PID^VADPT I $D(^DPT(DFN,"S",SDT,0)),$$VALID^SDAM2(DFN,SDCLN,SDT,SDDA) S SDATA=^DPT(DFN,"S",SDT,0),SDCL=SDCLN,SDNAME=VA("BID")_" "_$P($G(^DPT(DFN,0)),U) D:SDCLN=+SDATA BLD1^SDAM1 ;SD/478,492
- D NUL^SDAM10,LARGE^SDAM10:$D(SDLARGE)
- S $P(^TMP("SDAM",$J,0),U,4)=VALMCNT
- Q
- ;
- HDR ; -- list screen header
- ; input: SDCLN := ifn of pat
- ; output: VALMHDR() := hdr array
- ;
- S VALMHDR(1)=$E($P("Clinic: "_$G(^SC(SDCLN,0)),"^",1),1,45) ;for proper display of clinic name for SD*5.3*189
- Q
- ;
- CLN ; -- change clinic
- I $G(SDAMLIST)["CANCELLED" S VALMBCK="" W !!,*7,"You must be viewing a patient to list cancelled appointments." D PAUSE^VALM1 G CLNQ
- D FULL^VALM1 S VALMBCK="R"
- S X="" I $D(XQORNOD(0)) S X=$P($P(XQORNOD(0),U,4),"=",2)
- W ! S DIC="^SC(",DIC(0)=$S(X]"":"",1:"A")_"EMQ",DIC("A")="Select Clinic: ",DIC("S")="I $P(^(0),U,3)=""C"",'$G(^(""OOS""))"
- D ^DIC K DIC
- I Y<0 D G CLNQ
- .I SDAMTYP="C" S VALMSG=$C(7)_"Clinic has not been changed."
- .I SDAMTYP="P" S VALMSG=$C(7)_"View of patient remains in affect."
- I SDAMTYP'="C" D CHGCAP^VALM("NAME","Patient") S SDAMTYP="C"
- N SDRES I SDAMTYP="C" S SDRES=$$CLNCK^SDUTL2(+Y,1) I 'SDRES D G CLNQ
- .W !,?5,"Clinic MUST be corrected before continuing." D PAUSE^VALM1
- S SDCLN=+Y K SDFN D BLD
- CLNQ Q
- ;
- SDAM3 ;MJK/ALB - Appt Mgt (Clinic) ; 4/21/05 12:23pm
- +1 ;;5.3;Scheduling;**63,189,380,478,492,1003,1015**;Aug 13, 1993;Build 21
- +2 ;IHS/ANMC/LJF 8/18/2000 added warnings that clinic was inactivated
- +3 ; 7/12/2001 changed default list to all appts
- +4 ;IHS/ITSC/LJF 6/17/2005 PATCH 1003 allow appt threshold of zero
- +5 ;
- INIT ; -- get init clinic appt data
- +1 ; input: SDCLN := ifn of pat
- +2 ; output: ^TMP("SDAM" := appt array
- +3 ;
- +4 ;IHS/ANMC/LJF 8/18/2000
- IF '$$ACTV^BSDU(SDCLN,DT)
- Begin DoDot:1
- +5 ;IHS/ANMC/LJF 8/18/2000
- SET X="** Inactivated on "_$$INACTVDT^BSDU(SDCLN)_" **"
- +6 ;IHS/ANMC/LJF 8/18/2000
- DO EN^DDIOL(.X)
- End DoDot:1
- +7 ;
- +8 ;IHS/ITSC/LJF 6/17/2005 PATCH 1003
- +9 ;S X=$P($G(^DG(43,1,"SCLR")),U,12),SDPRD=$S(X:X,1:2)
- +10 SET X=$PIECE($GET(^DG(43,1,"SCLR")),U,12)
- SET SDPRD=$SELECT(X]"":X,1:2)
- +11 SET X1=DT
- SET X2=-SDPRD
- DO C^%DTC
- SET VALMB=X
- DO RANGE^VALM11
- +12 IF '$DATA(VALMBEG)
- SET VALMQUIT=""
- GOTO INITQ
- +13 SET SDBEG=VALMBEG
- SET SDEND=VALMEND
- +14 DO CHGCAP^VALM("NAME","Patient")
- +15 ;IHS/ANMC/LJF 7/12/2001 default to all appts
- +16 ;S X="NO ACTION TAKEN" D LIST^SDAM
- +17 SET X="ALL"
- DO LIST^SDAM
- +18 ;IHS/ANMC/LJF 7/12/2001 end of changes
- +19 ;
- INITQ KILL VALMB,VALMBEG,VALMEND
- QUIT
- +1 ;
- BLD ; -- scan apts
- +1 ; done for speed see INIT^SDAM10
- NEW VA,SDAMDD,SDNAME,SDMAX,SDLARGE,DFN,SDCL,BL,XC,XW,AC,AW,TC,TW,NC,NW,SC,SW,SDT,SDDA
- +2 DO INIT^SDAM10
- +3 FOR SDT=SDBEG:0
- SET SDT=$ORDER(^SC(SDCLN,"S",SDT))
- IF 'SDT!($PIECE(SDT,".",1)>SDEND)
- QUIT
- Begin DoDot:1
- +4 ;SD/478
- FOR SDDA=0:0
- SET SDDA=$ORDER(^SC(SDCLN,"S",SDT,1,SDDA))
- IF 'SDDA
- QUIT
- SET CNSTLNK=$PIECE($GET(^SC(SDCLN,"S",SDT,1,SDDA,"CONS")),U)
- SET CSTAT=""
- IF CNSTLNK'=""
- SET CSTAT=$PIECE($GET(^GMR(123,CNSTLNK,0)),U,12)
- Begin DoDot:2
- +5 ;SD/492
- IF $DATA(^SC(SDCLN,"S",SDT,1,SDDA,0))
- SET DFN=+^(0)
- Begin DoDot:3
- +6 ;SD/492
- NEW NDX,DA,FND
- +7 ;SD/492
- SET (FND,NDX)=""
- +8 ;SD/492
- FOR
- SET NDX=$ORDER(^TMP("SDAMIDX",$JOB,NDX))
- IF NDX=""
- QUIT
- Begin DoDot:4
- +9 ;SD/492
- SET DA=^TMP("SDAMIDX",$JOB,NDX)
- +10 ;SD/492
- IF $PIECE(DA,U,2)=DFN
- IF $PIECE(DA,U,3)=SDT
- IF $PIECE(DA,U,4)=SDCLN
- SET FND=1
- End DoDot:4
- IF FND
- QUIT
- +11 ;SD/492
- IF FND
- QUIT
- +12 ;SD/478,492
- DO PID^VADPT
- IF $DATA(^DPT(DFN,"S",SDT,0))
- IF $$VALID^SDAM2(DFN,SDCLN,SDT,SDDA)
- SET SDATA=^DPT(DFN,"S",SDT,0)
- SET SDCL=SDCLN
- SET SDNAME=VA("BID")_" "_$PIECE($GET(^DPT(DFN,0)),U)
- IF SDCLN=+SDATA
- DO BLD1^SDAM1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +13 DO NUL^SDAM10
- IF $DATA(SDLARGE)
- DO LARGE^SDAM10
- +14 SET $PIECE(^TMP("SDAM",$JOB,0),U,4)=VALMCNT
- +15 QUIT
- +16 ;
- HDR ; -- list screen header
- +1 ; input: SDCLN := ifn of pat
- +2 ; output: VALMHDR() := hdr array
- +3 ;
- +4 ;for proper display of clinic name for SD*5.3*189
- SET VALMHDR(1)=$EXTRACT($PIECE("Clinic: "_$GET(^SC(SDCLN,0)),"^",1),1,45)
- +5 QUIT
- +6 ;
- CLN ; -- change clinic
- +1 IF $GET(SDAMLIST)["CANCELLED"
- SET VALMBCK=""
- WRITE !!,*7,"You must be viewing a patient to list cancelled appointments."
- DO PAUSE^VALM1
- GOTO CLNQ
- +2 DO FULL^VALM1
- SET VALMBCK="R"
- +3 SET X=""
- IF $DATA(XQORNOD(0))
- SET X=$PIECE($PIECE(XQORNOD(0),U,4),"=",2)
- +4 WRITE !
- SET DIC="^SC("
- SET DIC(0)=$SELECT(X]"":"",1:"A")_"EMQ"
- SET DIC("A")="Select Clinic: "
- SET DIC("S")="I $P(^(0),U,3)=""C"",'$G(^(""OOS""))"
- +5 DO ^DIC
- KILL DIC
- +6 IF Y<0
- Begin DoDot:1
- +7 IF SDAMTYP="C"
- SET VALMSG=$CHAR(7)_"Clinic has not been changed."
- +8 IF SDAMTYP="P"
- SET VALMSG=$CHAR(7)_"View of patient remains in affect."
- End DoDot:1
- GOTO CLNQ
- +9 IF SDAMTYP'="C"
- DO CHGCAP^VALM("NAME","Patient")
- SET SDAMTYP="C"
- +10 NEW SDRES
- IF SDAMTYP="C"
- SET SDRES=$$CLNCK^SDUTL2(+Y,1)
- IF 'SDRES
- Begin DoDot:1
- +11 WRITE !,?5,"Clinic MUST be corrected before continuing."
- DO PAUSE^VALM1
- End DoDot:1
- GOTO CLNQ
- +12 SET SDCLN=+Y
- KILL SDFN
- DO BLD
- CLNQ QUIT
- +1 ;
