- BSDCCR1 ; IHS/ANMC/LJF - CLINIC CAPACITY REPORT CONTINUED ;
- ;;5.3;PIMS;;APR 26, 2002
- ;COPY OF SCRPW71 BEFORE PATCH #223
- ;IHS/ANMC/LJF 10/6/2000 IHS uses only one clinic code
- ;
- CLINIC(SC,SDFMT,SDSTRTDT,MAXDT,MAX,SDPAST) ;Evaluate a clinic
- ;Input: SC=clinic ifn
- ;Input: SDFMT='S' for totals only, 'D' for detail and totals
- ;Input: SDSTRTDT=begin date for data extraction
- ;Input: MAXDT=end date for data extraction
- ;Input: MAX=number of days in date range
- ;Input: SDPAST='0' for future dates, '1' for past dates
- ;Output: # of slots found^maximum capacity^error condition (1=success,-1=failure)^comment (if failure) or sort value (if success)
- N SC0,SDCP,X1,X2,X,%H,SDIV
- S SC0=$G(^SC(SC,0)) Q:$P(SC0,U,3)'="C" "0^0^-1^Not a clinic location type"
- Q:$P(SC0,U,17)="Y" "0^0^-1^Clinic defined as non-count"
- Q:'$$CPAIR(SC0,.SDCP) "0^0^-1^Not a valid primary clinic Stop Code"
- S X2=$P($G(^SC(SC,"SDP")),U,2) I X2 S X1=DT D C^%DTC S:X<MAXDT MAXDT=X
- Q:'$$ACTC(SC,SDSTRTDT,MAXDT) "0^0^-1^Clinic is inactivated during these dates"
- S SDIV=$$DIV(SC0) Q:'$L(SDIV) "0^0^-1^Invalid division number"
- D SPAT(SC,SDSTRTDT,MAXDT)
- Q $$CCNT(SC,MAX,SDCP,SDFMT,SDSTRTDT,SDIV,SDPAST)_"^1^"_SDCP_U_SC
- ;
- DIV(SC0) ;Get facility division name and number
- ;Input: SC0=hospital location zeroeth node
- N SDIV S SDIV=$P(SC0,U,15)
- Q:SDIV>0 $P($$SITE^VASITE(,SDIV),U,2,3)
- Q $P($$SITE^VASITE(),U,2,3)
- ;
- CPAIR(SC0,SDCP) ;Validate primary stop code, get credit pair
- ;Input: SC0=zeroeth node of HOSPITAL LOCATION record
- ;Input: SDCP=variable to return clinic credit pair (pass by reference)
- ;Output: 1=success, 0=invalid primary stop code
- S SDCP=$P($G(^DIC(40.7,+$P(SC0,U,7),0)),U,2) Q $S(SDCP="":0,1:1) ;IHS/ANMC/LJF 10/6/2000
- N SDSSC
- S SDCP=$P($G(^DIC(40.7,+$P(SC0,U,7),0)),U,2),SDCP=$S(SDCP<100:0,SDCP>999:0,1:SDCP)
- Q:SDCP'>0 0
- S SDSSC=$P($G(^DIC(40.7,+$P(SC0,U,18),0)),U,2),SDCP=SDCP_$S(SDSSC<100:"000",SDSSC>999:"000",1:SDSSC)
- Q 1
- ;
- ACTC(SC,SDSTRTDT,MAXDT) ;Determine if clinic is active during date range
- ;Input: SC=clinic ifn
- ;Input: SDSTRTDT=begin date for evaluation (TODAY+1)
- ;Input: MAXDT=maximum date in the future to evaluate (end date)
- ;Output: 1=active, 0=inactive during entire date range
- N SDIN,SDRE,X1,X2,X,%H
- S SDIN=$G(^SC(SC,"I")),SDRE=$P(SDIN,U,2),SDIN=$P(SDIN,U)
- Q:SDIN<1 1 Q:SDIN>SDSTRTDT 1
- I SDRE,SDRE'>MAXDT Q 1
- Q 0
- ;
- SPAT(SC,SDSTRTDT,ENDATE,SDS) ;Set patterns into ^TMP (modified clone of OVR^SDAUT1)
- ;Input: SC=clinic ifn
- ;Input: SDSTRTDT=start date for gathering patterns
- ;Input: ENDATE=date in future to evaluate to
- ;Input: SDS=array namespace subscript value (optional)
- ;Output: array of clinic current availability patterns in
- ; ^TMP(SDS,$J,clinic_ifn,"ST",date,1)
- ;
- S SDS=$G(SDS) S:'$L(SDS) SDS="SDTMP" K ^TMP(SDS,$J)
- N SI,SDIN,SDRE,SDSOH,X,X1,X2,SM,I,D,J,Y,SS,DAY
- S SDIN=$G(^SC(SC,"I")),SDRE=$P(SDIN,U,2),SDIN=$P(SDIN,U)
- S DAY="SU^MO^TU^WE^TH^FR^SA"
- S SI=$P($G(^SC(SC,"SL")),U,6),SI=$S(SI<3:4,1:SI)
- S SDSOH=$S('$D(^SC(SC,"SL")):0,$P(^SC(SC,"SL"),"^",8)']"":0,1:1)
- S SDIN=$G(SDIN),X=SDSTRTDT
- EN1 S:$O(^SC(SC,"T",0))>X X=$O(^SC(SC,"T",0))
- S Y=$$DOW^XLFDT(X,1),I=Y+32,SM=X,D=Y D WM
- K J F Y=0:1:6 I $D(^SC(+SC,"T"_Y)) S J(Y)=""
- I '$D(J) D Q
- .S D=SDSTRTDT-1 F S D=$O(^SC(SC,"ST",D)) Q:'D!(D>ENDATE) D
- ..S X=$G(^SC(SC,"ST",D,1)) S:$L(X) ^TMP(SDS,$J,SC,"ST",D,1)=X Q
- .Q
- X1 Q:X>ENDATE S X1=X\100_28
- I '$$ACTIVE(X,SDIN,SDRE) S X1=X,X2=1 D C^%DTC G X1
- W S X=X\1
- I $D(^SC(+SC,"ST",X,1)) S ^TMP(SDS,$J,SC,"ST",X,1)=^SC(+SC,"ST",X,1) G W1
- I '$D(^SC(SC,"ST",X,1)) S Y=D#7 G L:'$D(J(Y)),H:$D(^HOLIDAY(X))&('SDSOH) S SS=$O(^SC(SC,"T"_Y,X)) G L:SS<1,L:^SC(SC,"T"_Y,SS,1)="" D
- .S ^TMP(SDS,$J,SC,"ST",X\1,1)=$P(DAY,U,Y+1)_" "_$E(X,6,7)_$J("",SI+SI-6)_^SC(SC,"T"_Y,SS,1) Q
- W1 D WM:X>SM
- L Q:X>ENDATE S X=X+1,D=D+1 G W:X'>X1 S X2=X-X1 D C^%DTC G X1
- ;
- H S ^TMP(SDS,$J,SC,"ST",X,1)=" "_$E(X,6,7)_" "_$P(^(X,0),U,2) G W1
- ;
- WM S SM=$S($E(X,4,5)[12:$E(X,1,3)+1_"01",1:$E(X,1,3)_$E(X,4,5)+1)_"00" Q
- ;
- ACTIVE(X,SDIN,SDRE) ;Determine if the clinic is active on a given date
- ;Input: X=date to be examined
- ;Input: SDIN=clinic inactive date
- ;Input: SDRE=clinic reactivate date
- ;Output: '1'=active, '0'=inactive
- Q:'SDIN 1 Q:X<SDIN 1 Q:'SDRE 0 Q:X<SDRE 0 Q 1
- ;
- INIT ;Initialize array for counting patterns
- K SD N SDI
- S SD="123456789jklmnopqrstuvwxyz"
- F I=1:1:26 S SD($E(SD,I))=I
- Q
- ;
- CCNT(SC,MAX,SDCP,SDFMT,SDSTRTDT,SDIV,SDPAST) ;Count clinic availability and capacity
- ;Input: SC=clinic ifn
- ;Input: MAX=maximum days to evaluate availability
- ;Input: SDCP=credit pair
- ;Input: SDFMT=report format
- ;Input: SDSTRTDT=begin date of report
- ;Input: SDIV=clinic division number
- ;Input: SDPAST='0' for future dates, '1' for past dates
- ;Output: total # of open slots found^maximum capacity
- ;Output: Creates an array of:
- ; ^TMP("SD",$J,SDIV,SDCP)=open slots^maximum capacity^encounters
- ; ^TMP("SD",$J,SDIV,SDCP,SC)=open slots^maximum capacity^encounters
- ; ^TMP("SD",$J,SDIV,SDCP,SC,sub)=slots~capacity~encounters^slots~capacity~encounters ... etc. (up to 12 slots~capacity~encounters values)
- ; where 'sub' is a number 0 to nnn, 'sub' * 12 + "^" $PIECE where the data
- ; is stored equals the day which that data represents.
- ;
- N SDTOE
- S SDTOE=U_$P($G(^TMP("SD",$J,SDIV,SDCP,SC)),U,3) S:$L(SDTOE)=1 SDTOE=""
- Q:'$D(^TMP("SDTMP",$J)) "0^0"_SDTOE
- D:'$D(^TMP("SD",$J,SDIV,SDCP,SC)) ARRINI(SDCP,SC,MAX,SDPAST)
- N SDDAY,SDI,SDPATT,SDTSL,SDSL,SDTCAP,SDCAP,SDY
- S X1=SDSTRTDT,X2=-1 D C^%DTC S SDY=X
- S (SDTSL,SDTCAP)=0 F SDI=1:1:MAX D
- .S (SDSL,SDCAP)=0,X1=SDY,X2=SDI D C^%DTC S SDDAY=X
- .;Count open slots
- .S SDPATT=$E($G(^TMP("SDTMP",$J,SC,"ST",SDDAY,1)),6,999)
- .I SDPATT["[" D
- ..S SDSL=$$PCT(SDPATT),SDTSL=SDTSL+SDSL
- ..;Count maximum slots
- ..N X,%H,%T,%Y,SDDW,SDMPDT
- ..S SDCAP=0
- ..S SDPATT=$E($G(^SC(SC,"OST",SDDAY,1)),6,999) I $L(SDPATT) S SDCAP=$$PCT(SDPATT),SDTCAP=SDTCAP+SDCAP Q:SDCAP
- ..S X=SDDAY D H^%DTC S SDDW="T"_%Y,SDMPDT=$O(^SC(SC,SDDW,SDDAY))
- ..S SDPATT=$G(^SC(SC,SDDW,+SDMPDT,1)),SDCAP=$$PCT(SDPATT),SDTCAP=SDTCAP+SDCAP
- ..Q
- .D:SDFMT="D" ARRSET(SDCP,SC,SDI,SDSL,SDCAP) Q
- S $P(^TMP("SD",$J,SDIV,SDCP),U)=$P(^TMP("SD",$J,SDIV,SDCP),U)+SDTSL
- S $P(^TMP("SD",$J,SDIV,SDCP),U,2)=$P(^TMP("SD",$J,SDIV,SDCP),U,2)+SDTCAP
- S $P(^TMP("SD",$J,SDIV,SDCP,SC),U)=$P(^TMP("SD",$J,SDIV,SDCP,SC),U)+SDTSL
- S $P(^TMP("SD",$J,SDIV,SDCP,SC),U,2)=$P(^TMP("SD",$J,SDIV,SDCP,SC),U,2)+SDTCAP
- I SDPAST D
- .S $P(^TMP("SD",$J,SDIV,SDCP),U,3)=$P(^TMP("SD",$J,SDIV,SDCP),U,3)+0
- .S $P(^TMP("SD",$J,SDIV,SDCP,SC),U,3)=$P(^TMP("SD",$J,SDIV,SDCP,SC),U,3)+0 Q
- Q SDTSL_U_SDTCAP_SDTOE
- ;
- PCT(SDPATT) ;Pattern count
- ;Input: SDPATT=pattern to evaluate
- Q:SDPATT'["[" 0
- N X,I S X=0
- S SDPATT=$TR(SDPATT," |[]","")
- F I=1:1:$L(SDPATT) S X=X+$G(SD($E(SDPATT,I)))
- Q X
- ;
- ARRINI(SDCP,SC,MAX,SDPAST) ;Initialize array for counts
- ;Input: SDCP=credit pair
- ;Input: SC=clinic ifn
- ;Input: MAX=maximum days to report
- ;Input: SDPAST='0' for future dates, '1' for past dates
- N SDI,SDX,SDY,SDS,SDP
- S SDY="0~0" S:SDPAST SDY=SDY_"~0"
- S SDX="" F SDI=1:1:(2+SDPAST) S $P(SDX,U,SDI)=0
- S:'$D(^TMP("SD",$J,SDIV,SDCP)) ^TMP("SD",$J,SDIV,SDCP)=SDX
- S ^TMP("SD",$J,SDIV,SDCP,SC)=SDX Q:SDFMT'="D"
- F SDI=0:1:(MAX-1\12) S ^TMP("SD",$J,SDIV,SDCP,SC,SDI)=""
- F SDI=1:1:MAX D
- .S SDS=SDI-1\12,SDP=SDI#12 S:SDP=0 SDP=12
- .S $P(^TMP("SD",$J,SDIV,SDCP,SC,SDS),U,SDP)=SDY
- .Q
- Q
- ;
- ARRSET(SDCP,SC,SDI,SDSL,SDCAP) ;Set daily counts into array
- ;Input: SDCP=credit pair
- ;Input: SC=clinic ifn
- ;Input: SDI=number of days from report date
- ;Input: SDSL=number of open slots for day SDI
- ;Input: SDCAP=maximum slots for day SDI
- N SDS,SDP,SDX
- S SDS=SDI-1\12,SDP=SDI#12 S:SDP=0 SDP=12
- S SDX=$P(^TMP("SD",$J,SDIV,SDCP,SC,SDS),U,SDP)
- S $P(SDX,"~")=$P(SDX,"~")+SDSL
- S $P(SDX,"~",2)=$P(SDX,"~",2)+SDCAP
- I $G(SDPAST),$P(SDX,"~",3)="" S $P(SDX,"~",3)=0
- S $P(^TMP("SD",$J,SDIV,SDCP,SC,SDS),U,SDP)=SDX
- Q
- ;
- PCNT(X) ;Count open slots in a pattern
- ;Input: X=^SC(SC,"ST",SDT,1) node
- ;Output: number of open slots in a single date pattern
- N I,CT
- S CT=0 Q:X'["[" CT
- S X=$E(X,6,999),X=$TR(X,"|[] ","")
- F I=1:1:$L(X) S CT=CT+$G(SD($E(X,I)))
- Q CT
- BSDCCR1 ; IHS/ANMC/LJF - CLINIC CAPACITY REPORT CONTINUED ;
- +1 ;;5.3;PIMS;;APR 26, 2002
- +2 ;COPY OF SCRPW71 BEFORE PATCH #223
- +3 ;IHS/ANMC/LJF 10/6/2000 IHS uses only one clinic code
- +4 ;
- CLINIC(SC,SDFMT,SDSTRTDT,MAXDT,MAX,SDPAST) ;Evaluate a clinic
- +1 ;Input: SC=clinic ifn
- +2 ;Input: SDFMT='S' for totals only, 'D' for detail and totals
- +3 ;Input: SDSTRTDT=begin date for data extraction
- +4 ;Input: MAXDT=end date for data extraction
- +5 ;Input: MAX=number of days in date range
- +6 ;Input: SDPAST='0' for future dates, '1' for past dates
- +7 ;Output: # of slots found^maximum capacity^error condition (1=success,-1=failure)^comment (if failure) or sort value (if success)
- +8 NEW SC0,SDCP,X1,X2,X,%H,SDIV
- +9 SET SC0=$GET(^SC(SC,0))
- IF $PIECE(SC0,U,3)'="C"
- QUIT "0^0^-1^Not a clinic location type"
- +10 IF $PIECE(SC0,U,17)="Y"
- QUIT "0^0^-1^Clinic defined as non-count"
- +11 IF '$$CPAIR(SC0,.SDCP)
- QUIT "0^0^-1^Not a valid primary clinic Stop Code"
- +12 SET X2=$PIECE($GET(^SC(SC,"SDP")),U,2)
- IF X2
- SET X1=DT
- DO C^%DTC
- IF X<MAXDT
- SET MAXDT=X
- +13 IF '$$ACTC(SC,SDSTRTDT,MAXDT)
- QUIT "0^0^-1^Clinic is inactivated during these dates"
- +14 SET SDIV=$$DIV(SC0)
- IF '$LENGTH(SDIV)
- QUIT "0^0^-1^Invalid division number"
- +15 DO SPAT(SC,SDSTRTDT,MAXDT)
- +16 QUIT $$CCNT(SC,MAX,SDCP,SDFMT,SDSTRTDT,SDIV,SDPAST)_"^1^"_SDCP_U_SC
- +17 ;
- DIV(SC0) ;Get facility division name and number
- +1 ;Input: SC0=hospital location zeroeth node
- +2 NEW SDIV
- SET SDIV=$PIECE(SC0,U,15)
- +3 IF SDIV>0
- QUIT $PIECE($$SITE^VASITE(,SDIV),U,2,3)
- +4 QUIT $PIECE($$SITE^VASITE(),U,2,3)
- +5 ;
- CPAIR(SC0,SDCP) ;Validate primary stop code, get credit pair
- +1 ;Input: SC0=zeroeth node of HOSPITAL LOCATION record
- +2 ;Input: SDCP=variable to return clinic credit pair (pass by reference)
- +3 ;Output: 1=success, 0=invalid primary stop code
- +4 ;IHS/ANMC/LJF 10/6/2000
- SET SDCP=$PIECE($GET(^DIC(40.7,+$PIECE(SC0,U,7),0)),U,2)
- QUIT $SELECT(SDCP="":0,1:1)
- +5 NEW SDSSC
- +6 SET SDCP=$PIECE($GET(^DIC(40.7,+$PIECE(SC0,U,7),0)),U,2)
- SET SDCP=$SELECT(SDCP<100:0,SDCP>999:0,1:SDCP)
- +7 IF SDCP'>0
- QUIT 0
- +8 SET SDSSC=$PIECE($GET(^DIC(40.7,+$PIECE(SC0,U,18),0)),U,2)
- SET SDCP=SDCP_$SELECT(SDSSC<100:"000",SDSSC>999:"000",1:SDSSC)
- +9 QUIT 1
- +10 ;
- ACTC(SC,SDSTRTDT,MAXDT) ;Determine if clinic is active during date range
- +1 ;Input: SC=clinic ifn
- +2 ;Input: SDSTRTDT=begin date for evaluation (TODAY+1)
- +3 ;Input: MAXDT=maximum date in the future to evaluate (end date)
- +4 ;Output: 1=active, 0=inactive during entire date range
- +5 NEW SDIN,SDRE,X1,X2,X,%H
- +6 SET SDIN=$GET(^SC(SC,"I"))
- SET SDRE=$PIECE(SDIN,U,2)
- SET SDIN=$PIECE(SDIN,U)
- +7 IF SDIN<1
- QUIT 1
- IF SDIN>SDSTRTDT
- QUIT 1
- +8 IF SDRE
- IF SDRE'>MAXDT
- QUIT 1
- +9 QUIT 0
- +10 ;
- SPAT(SC,SDSTRTDT,ENDATE,SDS) ;Set patterns into ^TMP (modified clone of OVR^SDAUT1)
- +1 ;Input: SC=clinic ifn
- +2 ;Input: SDSTRTDT=start date for gathering patterns
- +3 ;Input: ENDATE=date in future to evaluate to
- +4 ;Input: SDS=array namespace subscript value (optional)
- +5 ;Output: array of clinic current availability patterns in
- +6 ; ^TMP(SDS,$J,clinic_ifn,"ST",date,1)
- +7 ;
- +8 SET SDS=$GET(SDS)
- IF '$LENGTH(SDS)
- SET SDS="SDTMP"
- KILL ^TMP(SDS,$JOB)
- +9 NEW SI,SDIN,SDRE,SDSOH,X,X1,X2,SM,I,D,J,Y,SS,DAY
- +10 SET SDIN=$GET(^SC(SC,"I"))
- SET SDRE=$PIECE(SDIN,U,2)
- SET SDIN=$PIECE(SDIN,U)
- +11 SET DAY="SU^MO^TU^WE^TH^FR^SA"
- +12 SET SI=$PIECE($GET(^SC(SC,"SL")),U,6)
- SET SI=$SELECT(SI<3:4,1:SI)
- +13 SET SDSOH=$SELECT('$DATA(^SC(SC,"SL")):0,$PIECE(^SC(SC,"SL"),"^",8)']"":0,1:1)
- +14 SET SDIN=$GET(SDIN)
- SET X=SDSTRTDT
- EN1 IF $ORDER(^SC(SC,"T",0))>X
- SET X=$ORDER(^SC(SC,"T",0))
- +1 SET Y=$$DOW^XLFDT(X,1)
- SET I=Y+32
- SET SM=X
- SET D=Y
- DO WM
- +2 KILL J
- FOR Y=0:1:6
- IF $DATA(^SC(+SC,"T"_Y))
- SET J(Y)=""
- +3 IF '$DATA(J)
- Begin DoDot:1
- +4 SET D=SDSTRTDT-1
- FOR
- SET D=$ORDER(^SC(SC,"ST",D))
- IF 'D!(D>ENDATE)
- QUIT
- Begin DoDot:2
- +5 SET X=$GET(^SC(SC,"ST",D,1))
- IF $LENGTH(X)
- SET ^TMP(SDS,$JOB,SC,"ST",D,1)=X
- QUIT
- End DoDot:2
- +6 QUIT
- End DoDot:1
- QUIT
- X1 IF X>ENDATE
- QUIT
- SET X1=X\100_28
- +1 IF '$$ACTIVE(X,SDIN,SDRE)
- SET X1=X
- SET X2=1
- DO C^%DTC
- GOTO X1
- W SET X=X\1
- +1 IF $DATA(^SC(+SC,"ST",X,1))
- SET ^TMP(SDS,$JOB,SC,"ST",X,1)=^SC(+SC,"ST",X,1)
- GOTO W1
- +2 IF '$DATA(^SC(SC,"ST",X,1))
- SET Y=D#7
- IF '$DATA(J(Y))
- GOTO L
- IF $DATA(^HOLIDAY(X))&('SDSOH)
- GOTO H
- SET SS=$ORDER(^SC(SC,"T"_Y,X))
- IF SS<1
- GOTO L
- IF ^SC(SC,"T"_Y,SS,1)=""
- GOTO L
- Begin DoDot:1
- +3 SET ^TMP(SDS,$JOB,SC,"ST",X\1,1)=$PIECE(DAY,U,Y+1)_" "_$EXTRACT(X,6,7)_$JUSTIFY("",SI+SI-6)_^SC(SC,"T"_Y,SS,1)
- QUIT
- End DoDot:1
- W1 IF X>SM
- DO WM
- L IF X>ENDATE
- QUIT
- SET X=X+1
- SET D=D+1
- IF X'>X1
- GOTO W
- SET X2=X-X1
- DO C^%DTC
- GOTO X1
- +1 ;
- H SET ^TMP(SDS,$JOB,SC,"ST",X,1)=" "_$EXTRACT(X,6,7)_" "_$PIECE(^(X,0),U,2)
- GOTO W1
- +1 ;
- WM SET SM=$SELECT($EXTRACT(X,4,5)[12:$EXTRACT(X,1,3)+1_"01",1:$EXTRACT(X,1,3)_$EXTRACT(X,4,5)+1)_"00"
- QUIT
- +1 ;
- ACTIVE(X,SDIN,SDRE) ;Determine if the clinic is active on a given date
- +1 ;Input: X=date to be examined
- +2 ;Input: SDIN=clinic inactive date
- +3 ;Input: SDRE=clinic reactivate date
- +4 ;Output: '1'=active, '0'=inactive
- +5 IF 'SDIN
- QUIT 1
- IF X<SDIN
- QUIT 1
- IF 'SDRE
- QUIT 0
- IF X<SDRE
- QUIT 0
- QUIT 1
- +6 ;
- INIT ;Initialize array for counting patterns
- +1 KILL SD
- NEW SDI
- +2 SET SD="123456789jklmnopqrstuvwxyz"
- +3 FOR I=1:1:26
- SET SD($EXTRACT(SD,I))=I
- +4 QUIT
- +5 ;
- CCNT(SC,MAX,SDCP,SDFMT,SDSTRTDT,SDIV,SDPAST) ;Count clinic availability and capacity
- +1 ;Input: SC=clinic ifn
- +2 ;Input: MAX=maximum days to evaluate availability
- +3 ;Input: SDCP=credit pair
- +4 ;Input: SDFMT=report format
- +5 ;Input: SDSTRTDT=begin date of report
- +6 ;Input: SDIV=clinic division number
- +7 ;Input: SDPAST='0' for future dates, '1' for past dates
- +8 ;Output: total # of open slots found^maximum capacity
- +9 ;Output: Creates an array of:
- +10 ; ^TMP("SD",$J,SDIV,SDCP)=open slots^maximum capacity^encounters
- +11 ; ^TMP("SD",$J,SDIV,SDCP,SC)=open slots^maximum capacity^encounters
- +12 ; ^TMP("SD",$J,SDIV,SDCP,SC,sub)=slots~capacity~encounters^slots~capacity~encounters ... etc. (up to 12 slots~capacity~encounters values)
- +13 ; where 'sub' is a number 0 to nnn, 'sub' * 12 + "^" $PIECE where the data
- +14 ; is stored equals the day which that data represents.
- +15 ;
- +16 NEW SDTOE
- +17 SET SDTOE=U_$PIECE($GET(^TMP("SD",$JOB,SDIV,SDCP,SC)),U,3)
- IF $LENGTH(SDTOE)=1
- SET SDTOE=""
- +18 IF '$DATA(^TMP("SDTMP",$JOB))
- QUIT "0^0"_SDTOE
- +19 IF '$DATA(^TMP("SD",$JOB,SDIV,SDCP,SC))
- DO ARRINI(SDCP,SC,MAX,SDPAST)
- +20 NEW SDDAY,SDI,SDPATT,SDTSL,SDSL,SDTCAP,SDCAP,SDY
- +21 SET X1=SDSTRTDT
- SET X2=-1
- DO C^%DTC
- SET SDY=X
- +22 SET (SDTSL,SDTCAP)=0
- FOR SDI=1:1:MAX
- Begin DoDot:1
- +23 SET (SDSL,SDCAP)=0
- SET X1=SDY
- SET X2=SDI
- DO C^%DTC
- SET SDDAY=X
- +24 ;Count open slots
- +25 SET SDPATT=$EXTRACT($GET(^TMP("SDTMP",$JOB,SC,"ST",SDDAY,1)),6,999)
- +26 IF SDPATT["["
- Begin DoDot:2
- +27 SET SDSL=$$PCT(SDPATT)
- SET SDTSL=SDTSL+SDSL
- +28 ;Count maximum slots
- +29 NEW X,%H,%T,%Y,SDDW,SDMPDT
- +30 SET SDCAP=0
- +31 SET SDPATT=$EXTRACT($GET(^SC(SC,"OST",SDDAY,1)),6,999)
- IF $LENGTH(SDPATT)
- SET SDCAP=$$PCT(SDPATT)
- SET SDTCAP=SDTCAP+SDCAP
- IF SDCAP
- QUIT
- +32 SET X=SDDAY
- DO H^%DTC
- SET SDDW="T"_%Y
- SET SDMPDT=$ORDER(^SC(SC,SDDW,SDDAY))
- +33 SET SDPATT=$GET(^SC(SC,SDDW,+SDMPDT,1))
- SET SDCAP=$$PCT(SDPATT)
- SET SDTCAP=SDTCAP+SDCAP
- +34 QUIT
- End DoDot:2
- +35 IF SDFMT="D"
- DO ARRSET(SDCP,SC,SDI,SDSL,SDCAP)
- QUIT
- End DoDot:1
- +36 SET $PIECE(^TMP("SD",$JOB,SDIV,SDCP),U)=$PIECE(^TMP("SD",$JOB,SDIV,SDCP),U)+SDTSL
- +37 SET $PIECE(^TMP("SD",$JOB,SDIV,SDCP),U,2)=$PIECE(^TMP("SD",$JOB,SDIV,SDCP),U,2)+SDTCAP
- +38 SET $PIECE(^TMP("SD",$JOB,SDIV,SDCP,SC),U)=$PIECE(^TMP("SD",$JOB,SDIV,SDCP,SC),U)+SDTSL
- +39 SET $PIECE(^TMP("SD",$JOB,SDIV,SDCP,SC),U,2)=$PIECE(^TMP("SD",$JOB,SDIV,SDCP,SC),U,2)+SDTCAP
- +40 IF SDPAST
- Begin DoDot:1
- +41 SET $PIECE(^TMP("SD",$JOB,SDIV,SDCP),U,3)=$PIECE(^TMP("SD",$JOB,SDIV,SDCP),U,3)+0
- +42 SET $PIECE(^TMP("SD",$JOB,SDIV,SDCP,SC),U,3)=$PIECE(^TMP("SD",$JOB,SDIV,SDCP,SC),U,3)+0
- QUIT
- End DoDot:1
- +43 QUIT SDTSL_U_SDTCAP_SDTOE
- +44 ;
- PCT(SDPATT) ;Pattern count
- +1 ;Input: SDPATT=pattern to evaluate
- +2 IF SDPATT'["["
- QUIT 0
- +3 NEW X,I
- SET X=0
- +4 SET SDPATT=$TRANSLATE(SDPATT," |[]","")
- +5 FOR I=1:1:$LENGTH(SDPATT)
- SET X=X+$GET(SD($EXTRACT(SDPATT,I)))
- +6 QUIT X
- +7 ;
- ARRINI(SDCP,SC,MAX,SDPAST) ;Initialize array for counts
- +1 ;Input: SDCP=credit pair
- +2 ;Input: SC=clinic ifn
- +3 ;Input: MAX=maximum days to report
- +4 ;Input: SDPAST='0' for future dates, '1' for past dates
- +5 NEW SDI,SDX,SDY,SDS,SDP
- +6 SET SDY="0~0"
- IF SDPAST
- SET SDY=SDY_"~0"
- +7 SET SDX=""
- FOR SDI=1:1:(2+SDPAST)
- SET $PIECE(SDX,U,SDI)=0
- +8 IF '$DATA(^TMP("SD",$JOB,SDIV,SDCP))
- SET ^TMP("SD",$JOB,SDIV,SDCP)=SDX
- +9 SET ^TMP("SD",$JOB,SDIV,SDCP,SC)=SDX
- IF SDFMT'="D"
- QUIT
- +10 FOR SDI=0:1:(MAX-1\12)
- SET ^TMP("SD",$JOB,SDIV,SDCP,SC,SDI)=""
- +11 FOR SDI=1:1:MAX
- Begin DoDot:1
- +12 SET SDS=SDI-1\12
- SET SDP=SDI#12
- IF SDP=0
- SET SDP=12
- +13 SET $PIECE(^TMP("SD",$JOB,SDIV,SDCP,SC,SDS),U,SDP)=SDY
- +14 QUIT
- End DoDot:1
- +15 QUIT
- +16 ;
- ARRSET(SDCP,SC,SDI,SDSL,SDCAP) ;Set daily counts into array
- +1 ;Input: SDCP=credit pair
- +2 ;Input: SC=clinic ifn
- +3 ;Input: SDI=number of days from report date
- +4 ;Input: SDSL=number of open slots for day SDI
- +5 ;Input: SDCAP=maximum slots for day SDI
- +6 NEW SDS,SDP,SDX
- +7 SET SDS=SDI-1\12
- SET SDP=SDI#12
- IF SDP=0
- SET SDP=12
- +8 SET SDX=$PIECE(^TMP("SD",$JOB,SDIV,SDCP,SC,SDS),U,SDP)
- +9 SET $PIECE(SDX,"~")=$PIECE(SDX,"~")+SDSL
- +10 SET $PIECE(SDX,"~",2)=$PIECE(SDX,"~",2)+SDCAP
- +11 IF $GET(SDPAST)
- IF $PIECE(SDX,"~",3)=""
- SET $PIECE(SDX,"~",3)=0
- +12 SET $PIECE(^TMP("SD",$JOB,SDIV,SDCP,SC,SDS),U,SDP)=SDX
- +13 QUIT
- +14 ;
- PCNT(X) ;Count open slots in a pattern
- +1 ;Input: X=^SC(SC,"ST",SDT,1) node
- +2 ;Output: number of open slots in a single date pattern
- +3 NEW I,CT
- +4 SET CT=0
- IF X'["["
- QUIT CT
- +5 SET X=$EXTRACT(X,6,999)
- SET X=$TRANSLATE(X,"|[] ","")
- +6 FOR I=1:1:$LENGTH(X)
- SET CT=CT+$GET(SD($EXTRACT(X,I)))
- +7 QUIT CT
