- SROUTUP ;B'HAM ISC/MAM - UPDATE UTILIZATION FILE ; [ 07/27/98 2:33 PM ]
- ;;3.0; Surgery ;**50**;24 Jun 93
- S X="T-1" D ^%DT S SRDTOLD=Y,X="T+6" D ^%DT S SRDTNEW=Y
- I '$D(^SRU(SRDTNEW)) K DA,DIC,DD,DO,DA S (X,DINUM)=SRDTNEW,DIC="^SRU(",DIC(0)="L",DLAYGO=131.8 D FILE^DICN K DIC,DLAYGO
- I '$O(^SRU(SRDTNEW,1,0)) S ^SRU(SRDTNEW,1,0)="^131.81PA^0^0"
- S SROR=0 F S SROR=$O(^SRS(SROR)) Q:'SROR I '$D(^SRU(SRDTNEW,1,SROR,0)),'$P(^SRS(SROR,0),"^",6) D OR
- D END
- Q
- I '$O(^SRU(SRDTOLD,2,0))!($D(^HOLIDAY(SRDTOLD,0))) D SPEC Q
- I $D(^HOLIDAY(SRDTNEW,0)) S SRHOLID=1,SRSITE=0 F S SRSITE=$O(^SRO(133,SRSITE)) Q:'SRSITE I $D(^SRO(133,SRSITE,3,SRDTNEW,0)) S SRHOLID=0
- I '$O(^SRU(SRDTNEW,2,0)) S ^SRU(SRDTNEW,2,0)="^131.82PA^0^0",SRSS=0 F S SRSS=$O(^SRU(SRDTOLD,2,SRSS)) Q:'SRSS D SPOLD
- END K SRSITE D ^SRSKILL
- Q
- OR ; set operating room times
- S SRSITE=$P(^SC($P(^SRS(SROR,0),"^"),0),"^",4) S:SRSITE SRSITE=$O(^SRO(133,"B",SRSITE,0))
- S (SRST,SRET,SRACT)="" I $D(^HOLIDAY(SRDTNEW,0)),SRSITE,'$D(^SRO(133,SRSITE,3,SRDTNEW,0)) S SRACT="Y" D SETOR Q
- I $D(^HOLIDAY(SRDTNEW,0)),'SRSITE S SRACT="Y" D SETOR Q
- S X=SRDTNEW D H^%DTC S SRDAY=%Y,SRWD=$O(^SRS(SROR,4,"B",SRDAY,0)) I 'SRWD D OLDOR,SETOR Q
- I $P(^SRS(SROR,4,SRWD,0),"^",2) S SRST=SRDTNEW_"."_$P(^SRS(SROR,4,SRWD,0),"^",2),SRST=+SRST
- I SRST,$P(^SRS(SROR,4,SRWD,0),"^",3) S SRET=SRDTNEW_"."_$P(^(0),"^",3),SRET=+SRET
- I SRST,'SRET S SRST=""
- I $P(^SRS(SROR,4,SRWD,0),"^",4) S SRACT="Y"
- I SRACT'="Y",'SRST D OLDOR
- SETOR S X=^SRU(SRDTNEW,1,0),$P(^(0),"^",3)=SROR,$P(^(0),"^",4)=$P(X,"^",4)+1
- S ^SRU(SRDTNEW,1,SROR,0)=SROR_"^"_SRST_"^"_SRET_"^"_SRACT
- Q
- OLDOR I '$D(^SRU(SRDTOLD,1,SROR,0))!($D(^HOLIDAY(SRDTOLD,0))) S SRST=SRDTNEW_".07",SRET=SRDTNEW_".17" Q
- S X=^SRU(SRDTOLD,1,SROR,0),SRST=$P(X,"^",2),SRET=$P(X,"^",3),SRACT=$P(X,"^",4)
- S SRST=$S(SRST:SRDTNEW_"."_$P(SRST,".",2),1:""),SRET=$S(SRET:SRDTNEW_"."_$P(SRET,".",2),1:"")
- Q
- SPOLD ; set specialty times from previous week
- S X=^SRU(SRDTOLD,2,SRSS,0),SRST=$P(X,"^",2),SRET=$P(X,"^",3),SRACT=$P(X,"^",4)
- S SRST1=$S(SRST:SRDTNEW_"."_$P(SRST,".",2),1:"")
- S SRET1=$S(SRET:SRDTNEW_"."_$P(SRET,".",2),1:"")
- I $D(^HOLIDAY(SRDTNEW,0)),SRHOLID S (SRST1,SRET1)="",SRACT="Y"
- S X=^SRU(SRDTNEW,2,0),$P(^(0),"^",3)=SRSS,$P(^(0),"^",4)=$P(X,"^",4)+1
- S ^SRU(SRDTNEW,2,SRSS,0)=SRSS_"^"_SRST1_"^"_SRET1_"^"_SRACT
- Q
- SPEC ; set specialty times if times from last week not used
- I $O(^SRU(SRDTNEW,2,0)) Q
- S ^SRU(SRDTNEW,2,0)="^131.82PA^0^0"
- S SRHOLID=0
- I $D(^HOLIDAY(SRDTNEW,0)) S SRHOLID=1,SRSITE=0 F S SRSITE=$O(^SRO(133,SRSITE)) Q:'SRSITE I $D(^SRO(133,SRSITE,3,SRDTNEW,0)) S SRHOLID=0
- S SRHRS=$S(SRHOLID:"^^^Y",1:"^"_SRDTNEW_".07^"_SRDTNEW_".17^")
- S SRSS=0 F S SRSS=$O(^SRO(137.45,SRSS)) Q:'SRSS S ^SRU(SRDTNEW,2,SRSS,0)=SRSS_SRHRS,X=$P(^SRU(SRDTNEW,2,0),"^",4),$P(^(0),"^",3)=SRSS,$P(^(0),"^",4)=X+1
- Q
- SROUTUP ;B'HAM ISC/MAM - UPDATE UTILIZATION FILE ; [ 07/27/98 2:33 PM ]
- +1 ;;3.0; Surgery ;**50**;24 Jun 93
- +2 SET X="T-1"
- DO ^%DT
- SET SRDTOLD=Y
- SET X="T+6"
- DO ^%DT
- SET SRDTNEW=Y
- +3 IF '$DATA(^SRU(SRDTNEW))
- KILL DA,DIC,DD,DO,DA
- SET (X,DINUM)=SRDTNEW
- SET DIC="^SRU("
- SET DIC(0)="L"
- SET DLAYGO=131.8
- DO FILE^DICN
- KILL DIC,DLAYGO
- +4 IF '$ORDER(^SRU(SRDTNEW,1,0))
- SET ^SRU(SRDTNEW,1,0)="^131.81PA^0^0"
- +5 SET SROR=0
- FOR
- SET SROR=$ORDER(^SRS(SROR))
- IF 'SROR
- QUIT
- IF '$DATA(^SRU(SRDTNEW,1,SROR,0))
- IF '$PIECE(^SRS(SROR,0),"^",6)
- DO OR
- +6 DO END
- +7 QUIT
- +8 IF '$ORDER(^SRU(SRDTOLD,2,0))!($DATA(^HOLIDAY(SRDTOLD,0)))
- DO SPEC
- QUIT
- +9 IF $DATA(^HOLIDAY(SRDTNEW,0))
- SET SRHOLID=1
- SET SRSITE=0
- FOR
- SET SRSITE=$ORDER(^SRO(133,SRSITE))
- IF 'SRSITE
- QUIT
- IF $DATA(^SRO(133,SRSITE,3,SRDTNEW,0))
- SET SRHOLID=0
- +10 IF '$ORDER(^SRU(SRDTNEW,2,0))
- SET ^SRU(SRDTNEW,2,0)="^131.82PA^0^0"
- SET SRSS=0
- FOR
- SET SRSS=$ORDER(^SRU(SRDTOLD,2,SRSS))
- IF 'SRSS
- QUIT
- DO SPOLD
- END KILL SRSITE
- DO ^SRSKILL
- +1 QUIT
- OR ; set operating room times
- +1 SET SRSITE=$PIECE(^SC($PIECE(^SRS(SROR,0),"^"),0),"^",4)
- IF SRSITE
- SET SRSITE=$ORDER(^SRO(133,"B",SRSITE,0))
- +2 SET (SRST,SRET,SRACT)=""
- IF $DATA(^HOLIDAY(SRDTNEW,0))
- IF SRSITE
- IF '$DATA(^SRO(133,SRSITE,3,SRDTNEW,0))
- SET SRACT="Y"
- DO SETOR
- QUIT
- +3 IF $DATA(^HOLIDAY(SRDTNEW,0))
- IF 'SRSITE
- SET SRACT="Y"
- DO SETOR
- QUIT
- +4 SET X=SRDTNEW
- DO H^%DTC
- SET SRDAY=%Y
- SET SRWD=$ORDER(^SRS(SROR,4,"B",SRDAY,0))
- IF 'SRWD
- DO OLDOR
- DO SETOR
- QUIT
- +5 IF $PIECE(^SRS(SROR,4,SRWD,0),"^",2)
- SET SRST=SRDTNEW_"."_$PIECE(^SRS(SROR,4,SRWD,0),"^",2)
- SET SRST=+SRST
- +6 IF SRST
- IF $PIECE(^SRS(SROR,4,SRWD,0),"^",3)
- SET SRET=SRDTNEW_"."_$PIECE(^(0),"^",3)
- SET SRET=+SRET
- +7 IF SRST
- IF 'SRET
- SET SRST=""
- +8 IF $PIECE(^SRS(SROR,4,SRWD,0),"^",4)
- SET SRACT="Y"
- +9 IF SRACT'="Y"
- IF 'SRST
- DO OLDOR
- SETOR SET X=^SRU(SRDTNEW,1,0)
- SET $PIECE(^(0),"^",3)=SROR
- SET $PIECE(^(0),"^",4)=$PIECE(X,"^",4)+1
- +1 SET ^SRU(SRDTNEW,1,SROR,0)=SROR_"^"_SRST_"^"_SRET_"^"_SRACT
- +2 QUIT
- OLDOR IF '$DATA(^SRU(SRDTOLD,1,SROR,0))!($DATA(^HOLIDAY(SRDTOLD,0)))
- SET SRST=SRDTNEW_".07"
- SET SRET=SRDTNEW_".17"
- QUIT
- +1 SET X=^SRU(SRDTOLD,1,SROR,0)
- SET SRST=$PIECE(X,"^",2)
- SET SRET=$PIECE(X,"^",3)
- SET SRACT=$PIECE(X,"^",4)
- +2 SET SRST=$SELECT(SRST:SRDTNEW_"."_$PIECE(SRST,".",2),1:"")
- SET SRET=$SELECT(SRET:SRDTNEW_"."_$PIECE(SRET,".",2),1:"")
- +3 QUIT
- SPOLD ; set specialty times from previous week
- +1 SET X=^SRU(SRDTOLD,2,SRSS,0)
- SET SRST=$PIECE(X,"^",2)
- SET SRET=$PIECE(X,"^",3)
- SET SRACT=$PIECE(X,"^",4)
- +2 SET SRST1=$SELECT(SRST:SRDTNEW_"."_$PIECE(SRST,".",2),1:"")
- +3 SET SRET1=$SELECT(SRET:SRDTNEW_"."_$PIECE(SRET,".",2),1:"")
- +4 IF $DATA(^HOLIDAY(SRDTNEW,0))
- IF SRHOLID
- SET (SRST1,SRET1)=""
- SET SRACT="Y"
- +5 SET X=^SRU(SRDTNEW,2,0)
- SET $PIECE(^(0),"^",3)=SRSS
- SET $PIECE(^(0),"^",4)=$PIECE(X,"^",4)+1
- +6 SET ^SRU(SRDTNEW,2,SRSS,0)=SRSS_"^"_SRST1_"^"_SRET1_"^"_SRACT
- +7 QUIT
- SPEC ; set specialty times if times from last week not used
- +1 IF $ORDER(^SRU(SRDTNEW,2,0))
- QUIT
- +2 SET ^SRU(SRDTNEW,2,0)="^131.82PA^0^0"
- +3 SET SRHOLID=0
- +4 IF $DATA(^HOLIDAY(SRDTNEW,0))
- SET SRHOLID=1
- SET SRSITE=0
- FOR
- SET SRSITE=$ORDER(^SRO(133,SRSITE))
- IF 'SRSITE
- QUIT
- IF $DATA(^SRO(133,SRSITE,3,SRDTNEW,0))
- SET SRHOLID=0
- +5 SET SRHRS=$SELECT(SRHOLID:"^^^Y",1:"^"_SRDTNEW_".07^"_SRDTNEW_".17^")
- +6 SET SRSS=0
- FOR
- SET SRSS=$ORDER(^SRO(137.45,SRSS))
- IF 'SRSS
- QUIT
- SET ^SRU(SRDTNEW,2,SRSS,0)=SRSS_SRHRS
- SET X=$PIECE(^SRU(SRDTNEW,2,0),"^",4)
- SET $PIECE(^(0),"^",3)=SRSS
- SET $PIECE(^(0),"^",4)=X+1
- +7 QUIT
