A1B2MSP.m

A1B2MSP ;ALB/AAS - UTILITY  TO SET BEDSECTIONSAND LOS FROM PTF ; 16-JAN-91

 ;;Version 1.55 (local for MAS v5 sites);;

 ;

% ;setup variables -

 K ^UTILITY($J)

 ;

1 ;build array of movement dates, billable specialties

 S A1B2MVMT=0 F A1B2I=0:0 S A1B2MVMT=$O(^DGPT(A1B2PTF,"M",A1B2MVMT)) Q:'A1B2MVMT  D SETU

 ;

2 ;build array of billable specialties = los in specialties

 ;  -- ptf record is closed, use all movements

 S (A1B2MVDT,A1B2MVDP)=$P(^DGPT(A1B2PTF,0),"^",2)

 S A1B2MVDT="" F I=0:0 S A1B2MVDT=$O(^UTILITY($J,"A1B2-PTF",A1B2MVDT)) Q:'A1B2MVDT  D SETU1 S A1B2MVDP=A1B2MVDT

 ;

3 ;find specialties and set up in file.

 S A1B2BS=""

 F A1B2I=0:0 S A1B2BS=$O(^UTILITY($J,"A1B2-BS",A1B2BS)) Q:A1B2BS']""  S A1B2LOS=^(A1B2BS),A1B2BSI=$O(^DGCR(399.1,"B",A1B2BS,0)) I A1B2BSI,$D(^DGCR(399.1,A1B2BSI,0)) D STORE

 G END

SETU ;utility array of all movements by date, billing specialty

 S X=^DGPT(A1B2PTF,"M",A1B2MVMT,0)

 S A1B2SPC=$S('$P(X,U,2):"UNKNOWN",$D(^DIC(42.4,$P(X,U,2),0)):$P(^(0),U,5),1:"UNKNOWN") Q:A1B2SPC=""

 S ^UTILITY($J,"A1B2-PTF",$S($P(X,U,10)]"":$P(X,U,10),1:DT),A1B2SPC)=$P(X,U,3)+$P(X,U,4)

 Q

SETU1 ;determine los - set utility=los

 S X1=A1B2MVDT,X2=A1B2MVDP D ^%DTC S A1B2BS=$O(^UTILITY($J,"A1B2-PTF",A1B2MVDT,0)),A1B2PASS=^(A1B2BS)

 S:((A1B2MVDP\1)=(A1B2MVDT\1)) X=1

 Q:((X-A1B2PASS)<1)

 I '$D(^UTILITY($J,"A1B2-BS",A1B2BS)) S ^UTILITY($J,"A1B2-BS",A1B2BS)=X-A1B2PASS Q

 S ^(A1B2BS)=^UTILITY($J,"A1B2-BS",A1B2BS)+(X-A1B2PASS)

 Q

STORE ;store bedsection and los in 11500.61

 S A1B2FL=11500.61,A1B2DT=A1B2BSI

 D ADD^A1B2UTL

 S DA=+Y,DR="[A1B2 SPECIALTY STUFF]",DIE="^A1B2(11500.61," D ^DIE

 Q

 ;

END ;K ^UTILITY($J)

 ;K A1B2EDT,A1B2MVMT,A1B2BS,A1B2BSI,A1B2LOS,A1B2MVDT,A1B2MVDP,A1B2SPC,A1B2PASS,A1B2I,X

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---A1B2MSP   1753     printed  Apr 09, 2024@21:24                                                                                                                                                                                                        Page 2

A1B2MSP   ;ALB/AAS - UTILITY  TO SET BEDSECTIONSAND LOS FROM PTF ; 16-JAN-91

 +1       ;;Version 1.55 (local for MAS v5 sites);;

 +2       ;

%         ;setup variables -

 +1        KILL ^UTILITY($JOB)

 +2       ;

1         ;build array of movement dates, billable specialties

 +1        SET A1B2MVMT=0

           FOR A1B2I=0:0

               SET A1B2MVMT=$ORDER(^DGPT(A1B2PTF,"M",A1B2MVMT))

               if 'A1B2MVMT

                   QUIT 

               DO SETU

 +2       ;

2         ;build array of billable specialties = los in specialties

 +1       ;  -- ptf record is closed, use all movements

 +2        SET (A1B2MVDT,A1B2MVDP)=$PIECE(^DGPT(A1B2PTF,0),"^",2)

 +3        SET A1B2MVDT=""

           FOR I=0:0

               SET A1B2MVDT=$ORDER(^UTILITY($JOB,"A1B2-PTF",A1B2MVDT))

               if 'A1B2MVDT

                   QUIT 

               DO SETU1

               SET A1B2MVDP=A1B2MVDT

 +4       ;

3         ;find specialties and set up in file.

 +1        SET A1B2BS=""

 +2        FOR A1B2I=0:0

               SET A1B2BS=$ORDER(^UTILITY($JOB,"A1B2-BS",A1B2BS))

               if A1B2BS']""

                   QUIT 

               SET A1B2LOS=^(A1B2BS)

               SET A1B2BSI=$ORDER(^DGCR(399.1,"B",A1B2BS,0))

               IF A1B2BSI

                   IF $DATA(^DGCR(399.1,A1B2BSI,0))

                       DO STORE

 +3        GOTO END

SETU      ;utility array of all movements by date, billing specialty

 +1        SET X=^DGPT(A1B2PTF,"M",A1B2MVMT,0)

 +2        SET A1B2SPC=$SELECT('$PIECE(X,U,2):"UNKNOWN",$DATA(^DIC(42.4,$PIECE(X,U,2),0)):$PIECE(^(0),U,5),1:"UNKNOWN")

           if A1B2SPC=""

               QUIT 

 +3        SET ^UTILITY($JOB,"A1B2-PTF",$SELECT($PIECE(X,U,10)]"":$PIECE(X,U,10),1:DT),A1B2SPC)=$PIECE(X,U,3)+$PIECE(X,U,4)

 +4        QUIT 

SETU1     ;determine los - set utility=los

 +1        SET X1=A1B2MVDT

           SET X2=A1B2MVDP

           DO ^%DTC

           SET A1B2BS=$ORDER(^UTILITY($JOB,"A1B2-PTF",A1B2MVDT,0))

           SET A1B2PASS=^(A1B2BS)

 +2        if ((A1B2MVDP\1)=(A1B2MVDT\1))

               SET X=1

 +3        if ((X-A1B2PASS)<1)

               QUIT 

 +4        IF '$DATA(^UTILITY($JOB,"A1B2-BS",A1B2BS))

               SET ^UTILITY($JOB,"A1B2-BS",A1B2BS)=X-A1B2PASS

               QUIT 

 +5        SET ^(A1B2BS)=^UTILITY($JOB,"A1B2-BS",A1B2BS)+(X-A1B2PASS)

 +6        QUIT 

STORE     ;store bedsection and los in 11500.61

 +1        SET A1B2FL=11500.61

           SET A1B2DT=A1B2BSI

 +2        DO ADD^A1B2UTL

 +3        SET DA=+Y

           SET DR="[A1B2 SPECIALTY STUFF]"

           SET DIE="^A1B2(11500.61,"

           DO ^DIE

 +4        QUIT 

 +5       ;

END       ;K ^UTILITY($J)

 +1       ;K A1B2EDT,A1B2MVMT,A1B2BS,A1B2BSI,A1B2LOS,A1B2MVDT,A1B2MVDP,A1B2SPC,A1B2PASS,A1B2I,X