SDAPIAP.m

SDAPIAP ;ALB/MJK - Outpatient API/Appointments ; 22 FEB 1994 11:30 am

 ;;5.3;Scheduling;**27,132,1015**;08/13/93;Build 21

 ;

EN(DFN,SDT,SDCL,SDUZ,SDMODE,SDVIEN) ; -- check api for appts

 N SDDA,SDOE

 S SDOE=0

 ; -- verify that check-out can occur

 D CHECK(DFN,SDT,SDCL,.SDDA) I $$ERRCHK^SDAPIER() G ENQ

 ;

 ; -- file check-out data ; get encount ien

 S SDOE=$$FILE(DFN,SDT,SDCL,SDUZ,SDDA,SDMODE,$G(SDVIEN))

 ;

ENQ Q SDOE

 ;

CHECK(DFN,SDT,SDCL,SDDA) ; -- check if event can occur/allowed

 N SDATA,STATUS

 ; -- error if appt node doesn't exist

 S SDATA=$G(^DPT(DFN,"S",SDT,0))

 I SDATA="" D ERRFILE^SDAPIER(100,SDT_U_DFN) G CHECKQ

 ;

 ; -- error if different clinic

 I +SDATA'=SDCL D ERRFILE^SDAPIER(101,+SDATA_U_SDCL) G CHECKQ

 ;

 ; -- error if no slot for appt

 S SDDA=$$FIND^SDAM2(DFN,SDT,SDCL) I 'SDDA D ERRFILE^SDAPIER(102,SDT_U_SDCL) G CHECKQ

 ;

 ; -- get appt status data 

 S STATUS=$$STATUS^SDAM1(DFN,SDT,SDCL,SDATA,SDDA)

 ;

 ; -- error if current status won't allow checking-out

 I '$D(^SD(409.63,"ACO",1,+STATUS)) D ERRFILE^SDAPIER(103,$P(STATUS,";",2)) G CHECKQ

 ;

 ; -- warning if already checked-out

 I $P(STATUS,";",2)="CHECKED OUT" D ERRFILE^SDAPIER(1100)

 ;

 ; -- error if appt date if after today

 I SDT>(DT+.2359) D ERRFILE^SDAPIER(104,SDT) G CHECKQ

CHECKQ Q

 ;

FILE(DFN,SDT,SDCL,SDUZ,SDDA,SDMODE,SDVIEN) ; -- file data

 N SDATA,SDHDL,SDOE,SDCOMPF,SDLOG

 S SDOE=""

 ;

 ; -- setup event driver data

 D BEFORE^SDCO1(.SDATA,DFN,SDT,SDCL,SDDA,.SDHDL)

 ;

 ; -- set elig for appt

 D ELIG^SDCO1(DFN,SDT,SDCL,SDDA) ; may need to expand

 ;

 ; -- get encounter ien ; error if none returned

 S SDOE=$$GETAPT^SDVSIT2(DFN,SDT,SDCL,$G(SDVIEN))

 I 'SDOE D ERRFILE^SDAPIER(110) G FILEQ

 ;

 ; -- time stamp check-out and log data

 D DT(DFN,SDT,SDCL,SDDA,$G(@SDROOT@("DATE/TIME")))

 D LOGDATA(SDOE)

 ;

 ; -- process data

 D FILE^SDAPICO(SDOE,SDUZ)

 ;

 ; -- update check-out completion

 D EN^SDCOM(SDOE,SDMODE,SDHDL,.SDCOMPF)

 ;

 ; -- set visit change flag for event driver

 D CHANGE^SDAMEVT4(.SDHDL,$P($G(^SCE(SDOE,0)),U,8),$G(@SDROOT@("VISIT CHANGE FLAGS")))

 ;

 ; -- get after values and invoke event driver

 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL)

 D EVT^SDAMEVT(.SDATA,5,SDMODE,SDHDL)

 ;

 ; -- cleanup event driver vars

 D CLEAN^SDAMEVT(SDHDL)

 ;

FILEQ Q SDOE

 ;

DT(DFN,SDT,SDCL,SDDA,SDCODT) ; -- time stamp check out date

 ; -- NOTE: this code duplicates at DT^SDCO1 but silent

 N %DT,DR,SDCIDT,X,DIE,DA

 S:'$D(^SC(SDCL,"S",0)) ^(0)="^44.001DA^^"

 S X=$G(^SC(SDCL,"S",SDT,1,SDDA,"C")),SDCIDT=+X

 ;IF $P(X,U,3) G DTQ

 S DR="" IF $G(SDCODT) S DR="303R////"_$S(SDCODT<SDCIDT:SDCIDT,1:SDCODT)

 IF DR]"" D DIE^SDCO1(SDCL,SDT,SDDA,DR)

DTQ Q

 ;

LOGDATA(SDOE,SDLOG) ; -- log user, date/time and other data

 N DIE,DA,DR,Y,X

 S SDLOG("USER")=$S(+$G(SDUZ):+SDUZ,1:$G(DUZ)) ; -- editing user

 S SDLOG("DATE/TIME")=$$NOW^XLFDT()            ; -- last edited 

 S DIE="^SCE(",DA=SDOE,DR="[SD ENCOUNTER LOG]" D ^DIE

 Q

 ;

SDAPIAP   ;ALB/MJK - Outpatient API/Appointments ; 22 FEB 1994 11:30 am

 +1       ;;5.3;Scheduling;**27,132,1015**;08/13/93;Build 21

 +2       ;

EN(DFN,SDT,SDCL,SDUZ,SDMODE,SDVIEN) ; -- check api for appts

 +1        NEW SDDA,SDOE

 +2        SET SDOE=0

 +3       ; -- verify that check-out can occur

 +4        DO CHECK(DFN,SDT,SDCL,.SDDA)

           IF $$ERRCHK^SDAPIER()

               GOTO ENQ

 +5       ;

 +6       ; -- file check-out data ; get encount ien

 +7        SET SDOE=$$FILE(DFN,SDT,SDCL,SDUZ,SDDA,SDMODE,$GET(SDVIEN))

 +8       ;

ENQ        QUIT SDOE

 +1       ;

CHECK(DFN,SDT,SDCL,SDDA) ; -- check if event can occur/allowed

 +1        NEW SDATA,STATUS

 +2       ; -- error if appt node doesn't exist

 +3        SET SDATA=$GET(^DPT(DFN,"S",SDT,0))

 +4        IF SDATA=""

               DO ERRFILE^SDAPIER(100,SDT_U_DFN)

               GOTO CHECKQ

 +5       ;

 +6       ; -- error if different clinic

 +7        IF +SDATA'=SDCL

               DO ERRFILE^SDAPIER(101,+SDATA_U_SDCL)

               GOTO CHECKQ

 +8       ;

 +9       ; -- error if no slot for appt

 +10       SET SDDA=$$FIND^SDAM2(DFN,SDT,SDCL)

           IF 'SDDA

               DO ERRFILE^SDAPIER(102,SDT_U_SDCL)

               GOTO CHECKQ

 +11      ;

 +12      ; -- get appt status data 

 +13       SET STATUS=$$STATUS^SDAM1(DFN,SDT,SDCL,SDATA,SDDA)

 +14      ;

 +15      ; -- error if current status won't allow checking-out

 +16       IF '$DATA(^SD(409.63,"ACO",1,+STATUS))

               DO ERRFILE^SDAPIER(103,$PIECE(STATUS,";",2))

               GOTO CHECKQ

 +17      ;

 +18      ; -- warning if already checked-out

 +19       IF $PIECE(STATUS,";",2)="CHECKED OUT"

               DO ERRFILE^SDAPIER(1100)

 +20      ;

 +21      ; -- error if appt date if after today

 +22       IF SDT>(DT+.2359)

               DO ERRFILE^SDAPIER(104,SDT)

               GOTO CHECKQ

CHECKQ     QUIT 

 +1       ;

FILE(DFN,SDT,SDCL,SDUZ,SDDA,SDMODE,SDVIEN) ; -- file data

 +1        NEW SDATA,SDHDL,SDOE,SDCOMPF,SDLOG

 +2        SET SDOE=""

 +3       ;

 +4       ; -- setup event driver data

 +5        DO BEFORE^SDCO1(.SDATA,DFN,SDT,SDCL,SDDA,.SDHDL)

 +6       ;

 +7       ; -- set elig for appt

 +8       ; may need to expand

           DO ELIG^SDCO1(DFN,SDT,SDCL,SDDA)

 +9       ;

 +10      ; -- get encounter ien ; error if none returned

 +11       SET SDOE=$$GETAPT^SDVSIT2(DFN,SDT,SDCL,$GET(SDVIEN))

 +12       IF 'SDOE

               DO ERRFILE^SDAPIER(110)

               GOTO FILEQ

 +13      ;

 +14      ; -- time stamp check-out and log data

 +15       DO DT(DFN,SDT,SDCL,SDDA,$GET(@SDROOT@("DATE/TIME")))

 +16       DO LOGDATA(SDOE)

 +17      ;

 +18      ; -- process data

 +19       DO FILE^SDAPICO(SDOE,SDUZ)

 +20      ;

 +21      ; -- update check-out completion

 +22       DO EN^SDCOM(SDOE,SDMODE,SDHDL,.SDCOMPF)

 +23      ;

 +24      ; -- set visit change flag for event driver

 +25       DO CHANGE^SDAMEVT4(.SDHDL,$PIECE($GET(^SCE(SDOE,0)),U,8),$GET(@SDROOT@("VISIT CHANGE FLAGS")))

 +26      ;

 +27      ; -- get after values and invoke event driver

 +28       DO AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDHDL)

 +29       DO EVT^SDAMEVT(.SDATA,5,SDMODE,SDHDL)

 +30      ;

 +31      ; -- cleanup event driver vars

 +32       DO CLEAN^SDAMEVT(SDHDL)

 +33      ;

FILEQ      QUIT SDOE

 +1       ;

DT(DFN,SDT,SDCL,SDDA,SDCODT) ; -- time stamp check out date

 +1       ; -- NOTE: this code duplicates at DT^SDCO1 but silent

 +2        NEW %DT,DR,SDCIDT,X,DIE,DA

 +3        IF '$DATA(^SC(SDCL,"S",0))

               SET ^(0)="^44.001DA^^"

 +4        SET X=$GET(^SC(SDCL,"S",SDT,1,SDDA,"C"))

           SET SDCIDT=+X

 +5       ;IF $P(X,U,3) G DTQ

 +6        SET DR=""

           IF $GET(SDCODT)

               SET DR="303R////"_$SELECT(SDCODT<SDCIDT:SDCIDT,1:SDCODT)

 +7        IF DR]""

               DO DIE^SDCO1(SDCL,SDT,SDDA,DR)

DTQ        QUIT 

 +1       ;

LOGDATA(SDOE,SDLOG) ; -- log user, date/time and other data

 +1        NEW DIE,DA,DR,Y,X

 +2       ; -- editing user

           SET SDLOG("USER")=$SELECT(+$GET(SDUZ):+SDUZ,1:$GET(DUZ))

 +3       ; -- last edited 

           SET SDLOG("DATE/TIME")=$$NOW^XLFDT()

 +4        SET DIE="^SCE("

           SET DA=SDOE

           SET DR="[SD ENCOUNTER LOG]"

           DO ^DIE

 +5        QUIT 

 +6       ;