- 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 ---[H[J[2J[HA1B2MSP 1753 printed Feb 18, 2025@23:47:34 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
