Changeset 1467 for Scheduling/trunk/m/BSDXAPI1.m

Timestamp:

Jul 5, 2012, 7:42:34 PM (12 years ago)

Author:

Sam Habiel

Message:

BSDX25 refactoring is done; moved PIMS availability change logic from BSDX07 and BSDX08 to BSDXAPI*.m. Calling these has moved from BSDX07 and BSDX08 to 1926MAKE and 1926CANCEL^BSDXAPI.

File:

• Scheduling/trunk/m/BSDXAPI1.m (modified) (5 diffs)

Scheduling/trunk/m/BSDXAPI1.m

@@ -1 @@
-BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/3/12 12:37pm
+BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/5/12 12:55pm
         ;;1.7T1;BSDX;;Aug 31, 2011;Build 18
         ; Licensed under LGPL  
@@ -42 +42 @@
         ; CANCELCK exists for the same purpose.
         ; CHECKINK ditto
-        ; New API: $$NOWSHOW^BSDXAPI1 for no-showing patients
+        ; New API: $$NOSHOW^BSDXAPI1 for no-showing patients
         ; Moved RMCI from BSDXAPI to BSDXAPI1 because BSDXAPI1 is getting larger
         ;  than 20000 characters.
+        ; Added RMCICK (Remove check-in check)
+        ; Moved Availability update EPs in BSDX07 and BSDX08 b/c they really
+        ; belong to PIMS, not to the Scheduling GUI. $$MAKE and $$CANCEL now
+        ; call the EPs here.
         ;
 NOSHOW(PAT,CLINIC,DATE,NSFLAG) ; $$ PEP; No-show Patient at appt date (new in v1.7)
@@ -125 +129 @@
         D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
         ;
+        ; M Error Test - Simulate behavior when an M error occurs
+        I $G(BSDXDIE2) N X S X=1/0
+        ; 
+        ; Simulate a failure to file the data in Fileman
+        I $D(BSDXSIMERR3) Q 1_U_"Simulated Error"
+        ;
         ; remove check-in using filer.
         N BSDXIENS S BSDXIENS=SDDA_","_DATE_","_CLINIC_","
@@ -150 +160 @@
         ; Output: 0 if okay or 1 if error
         ;
+        ; Error for Unit Tests
+        I $G(BSDXSIMERR2) Q 1_U_"Simulated Error"
+        ;
         ; Get appointment IEN in ^SC(DA(2),"S",DA(1),1,
         N SCIEN S SCIEN=$$SCIEN^BSDXAPI(PAT,CLINIC,DATE)
         ;
-        ; If not there, it has been cancelled.
+        ; If not there, it has been cancelled. Okay to Remove Check-in.
         I 'SCIEN QUIT 0
         ;
@@ -182 +195 @@
         QUIT 0
         ;
+AVUPDTCN(BSDXSCD,BSDXSTART,BSDXLEN)     ;Update PIMS Clinic availability for cancel
+        ; NB: VEN/SMH: This code has never been tested. It's here for its
+        ; presumptive function, but I don't know whether it works accurately!
+        ;See SDCNP0
+        N SD,S  ; Start Date
+        S (SD,S)=BSDXSTART
+        N I ; Clinic IEN in 44
+        S I=BSDXSCD
+        ; if day has no schedule in legacy PIMS, forget about this update.
+        Q:'$D(^SC(I,"ST",SD\1,1))
+        N SL ; Clinic characteristics node (length of appt, when appts start etc)
+        S SL=^SC(I,"SL")
+        N X ; Hour Clinic Display Begins
+        S X=$P(SL,U,3)
+        N STARTDAY ; When does the day start?
+        S STARTDAY=$S($L(X):X,1:8) ; If defined, use it; otherwise, 8am
+        N SB ; ?? Who knows? Day Start - 1 divided by 100.
+        S SB=STARTDAY-1/100
+        S X=$P(SL,U,6) ; Now X is Display increments per hour
+        N HSI ; Slots per hour, try 1
+        S HSI=$S(X:X,1:4) ; if defined, use it; otherwise, 4
+        N SI ; Slots per hour, try 2
+        S SI=$S(X="":4,X<3:4,X:X,1:4) ; If slots "", or less than 3, then 4
+        N STR ; ??
+        S STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
+        N SDDIF ; Slots per hour diff??
+        S SDDIF=$S(HSI<3:8/HSI,1:2)
+        S SL=BSDXLEN ; Dammit, reusing variable; SL now Appt Length from GUI
+        S S=^SC(I,"ST",SD\1,1) ; reusing var again; S now Day Pattern from PIMS
+        N Y ; Hours since start of Date
+        S Y=SD#1-SB*100 ;SD#1=FM Time portion; -SB minus start of day; conv to hrs
+        N ST  ; ??
+        ; Y#1 -> Minutes; *SI -> * Slots per hour; \.6 trunc min to hour
+        ; Y\1 -> Hours since start of day; * SI: * slots
+        S ST=Y#1*SI\.6+(Y\1*SI)
+        N SS ; how many slots are supposed to be taken by appointment
+        S SS=SL*HSI/60 ; (nb: try SL: 30 min; HSI: 4 slots)
+        N I
+        I Y'<1 D  ; If Hours since start of Date is greater than 1
+        . ; loop through pattern. Tired of documenting.
+        . F I=ST+ST:SDDIF D  Q:Y=""  Q:SS'>0
+        . . S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y=""
+        . . S S=$E(S,1,I)_Y_$E(S,I+2,999)
+        . . S SS=SS-1
+        . . Q:SS'>0
+        S ^SC(BSDXSCD,"ST",SD\1,1)=S  ; new pattern; global set
+        Q
+        ;
+AVUPDTMK(BSDXSCD,BSDXSTART,BSDXLEN) ; Update RPMS Clinic availability for Make
+        ;SEE SDM1
+        N Y,DFN
+        N SL,STARTDAY,X,SC,SB,HSI,SI,STR,SDDIF,SDMAX,SDDATE,SDDMAX,SDSDATE,CCXN,MXOK,COV,SDPROG
+        N X1,SDEDT,X2,SD,SM,SS,S,SDLOCK,ST,I
+        S Y=BSDXSCD,DFN=BSDXPATID
+        S SL=$G(^SC(+Y,"SL")),X=$P(SL,U,3),STARTDAY=$S($L(X):X,1:8),SC=Y,SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X=1:X,X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2) K Y
+        ;Determine maximum days for scheduling
+        S SDMAX(1)=$P($G(^SC(+SC,"SDP")),U,2) S:'SDMAX(1) SDMAX(1)=365
+        S (SDMAX,SDDMAX)=$$FMADD^XLFDT(DT,SDMAX(1))
+        S SDDATE=BSDXSTART
+        S SDSDATE=SDDATE,SDDATE=SDDATE\1
+1 ;L  Q:$D(SDXXX)  S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0  S SC=+SC
+        Q:$D(SDXXX)  S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0  S SC=+SC
+        S X1=DT,SDEDT=365 S:$D(^SC(SC,"SDP")) SDEDT=$P(^SC(SC,"SDP"),"^",2)
+        S X2=SDEDT D C^%DTC S SDEDT=X
+        S Y=BSDXSTART
+EN1     S (X,SD)=Y,SM=0 D DOW
+S       I '$D(^SC(SC,"ST",$P(SD,"."),1)) S SS=+$O(^SC(+SC,"T"_Y,SD)) Q:SS'>0  Q:^(SS,1)=""  S ^SC(+SC,"ST",$P(SD,"."),1)=$E($P($T(DAY),U,Y+2),1,2)_" "_$E(SD,6,7)_$J("",SI+SI-6)_^(1),^(0)=$P(SD,".")
+        S S=BSDXLEN
+        ;Check if BSDXLEN evenly divisible by appointment length
+        S RPMSL=$P(SL,U)
+        I BSDXLEN<RPMSL S BSDXLEN=RPMSL
+        I BSDXLEN#RPMSL'=0 D
+        . S BSDXINC=BSDXLEN\RPMSL
+        . S BSDXINC=BSDXINC+1
+        . S BSDXLEN=RPMSL*BSDXINC
+        S SL=S_U_$P(SL,U,2,99)
+SC      S SDLOCK=$S('$D(SDLOCK):1,1:SDLOCK+1) Q:SDLOCK>9
+        L +^SC(SC,"ST",$P(SD,"."),1):5 G:'$T SC
+        S SDLOCK=0,S=^SC(SC,"ST",$P(SD,"."),1)
+        S I=SD#1-SB*100,ST=I#1*SI\.6+($P(I,".")*SI),SS=SL*HSI/60*SDDIF+ST+ST
+        I (I<1!'$F(S,"["))&(S'["CAN") L -^SC(SC,"ST",$P(SD,"."),1) Q
+        I SM<7 S %=$F(S,"[",SS-1) S:'%!($P(SL,"^",6)<3) %=999 I $F(S,"]",SS)'<%!(SDDIF=2&$E(S,ST+ST+1,SS-1)["[") S SM=7
+        ;
+SP      I ST+ST>$L(S),$L(S)<80 S S=S_" " G SP
+        S SDNOT=1
+        S ABORT=0
+        F I=ST+ST:SDDIF:SS-SDDIF D  Q:ABORT
+        . S ST=$E(S,I+1) S:ST="" ST=" "
+        . S Y=$E(STR,$F(STR,ST)-2)
+        . I S["CAN"!(ST="X"&($D(^SC(+SC,"ST",$P(SD,"."),"CAN")))) S ABORT=1 Q
+        . I Y="" S ABORT=1 Q
+        . S:Y'?1NL&(SM<6) SM=6 S ST=$E(S,I+2,999) S:ST="" ST=" " S S=$E(S,1,I)_Y_ST
+        . Q
+        S ^SC(SC,"ST",$P(SD,"."),1)=S
+        L -^SC(SC,"ST",$P(SD,"."),1)
+        Q
+DAY     ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR
+        ;
+DOW     S %=$E(X,1,3),Y=$E(X,4,5),Y=Y>2&'(%#4)+$E("144025036146",Y)
+        F %=%:-1:281 S Y=%#4=1+1+Y
+        S Y=$E(X,6,7)+Y#7
+        Q
+        ;