- NURAR11A ;HIRMFO/MD-COMPARISON REPORT BY LOCATION ;7/10/97
- ;;4.0;NURSING SERVICE;**2,32**;Apr 25, 1997
- S X=$G(^DIC(213.9,1,"OFF")) Q:X=""!(X=1)
- S (NURQUEUE,NUROUT)=0
- D EN1^NURSAUTL G QUIT:NUROUT
- I $G(NURMDSW) W ! S DIC(0)="AEQZ",NURPLSCR=1 D EN5^NURSAGSP K NURPLSCR G:$G(NUROUT) QUIT
- I '$G(NURMDSW),$G(NURPLSW) S NURPLSCR=1 D PRD^NURSAGSP K NURPLSCR G:(NUROUT) QUIT
- W ! D EN1^NURSAGSP G:$G(NUROUT) QUIT
- W ! S:NURHOSP NWRD=""
- S ZTRTN="START^NURAR11A" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
- START ;
- K ^TMP("NURA",$J)
- W ! I 'NURHOSP S NURSX="" F S NURSX=$O(NURSNLOC(NURSX)) Q:NURSX="" S NWRD=0 F S NWRD=$O(NURSNLOC(NURSX,NWRD)) Q:NWRD'>0 D:$S('$D(^NURSF(211.4,NWRD,"I")):1,$P(^("I"),"^")="A":1,1:0) GETNODE
- I NURHOSP F NWRD=0:0 S NWRD=$O(^NURSF(211.4,NWRD)) Q:NWRD'>0 D:$S('$D(^NURSF(211.4,NWRD,"I")):1,$P(^("I"),"^")="A":1,1:0) GETNODE
- I NURSZAP=7 D
- . S NPWARD=$O(NURSZLO(0)) D EN6^NURSAUTL
- . S Z=$O(^TMP("NURA",$J,Z)) Q:Z="" S X="" F Y=0:0 S X=$O(^TMP("NURA",$J,Z,X)) Q:X="" K:$S(NPWARD="":1,'(X=NPWARD):1,1:0) ^TMP("NURA",$J,Z,X)
- . K X,Y Q
- . Q
- S (NURQUIT,NURSW1,NURPAGE,NAFTE,NTOTA,NTOTB,NTRB,NTRA,NTRAT,NTLB,NTLA,NTLAT,NTNA,NTNB,NTNAT,NTCA,NTCB,NTCAT,NTAA,NTAB,NTAAT,NTOA,NTOB,NTOAT)=0
- U IO D EN1^NURAR110 W !
- QUIT K ^TMP("NURA",$J) D CLOSE^NURSUT1,^NURAKILL
- Q
- GETNODE ;
- S NPWARD=NWRD D EN6^NURSAUTL S NL1=NPWARD,NO=$S('$D(^NURSF(211.4,NWRD,0)):"",$P(^(0),"^")'="":$P(^(0),"^"),1:"") Q:NL1="MASONLY"!(NL1="MAS ONLY")
- I NURMDSW S NURFAC(2)=$$EN12^NURSUT3($G(NWRD)) Q:$G(NURFAC(2))=""
- E S NURFAC(2)=" BLANK"
- I NURPLSW S X=+$P($G(^NURSF(211.4,NWRD,1)),U,4),NURPROG(2)=$S($$GET1^DIQ(212.7,X,.01,"I")'="":$$GET1^DIQ(212.7,X,.01,"I"),1:" BLANK")
- E S NURPROG(2)=" BLANK"
- I NURMDSW,'$G(NURFAC),$G(NURFAC(1))'=" BLANK" Q:NURFAC(1)'=NURFAC(2)
- I NURPLSW,'$G(NURPROG),$G(NURPROG(2))'=" BLANK",$G(NURPROG(1))'="" Q:NURPROG(1)'=NURPROG(2)
- S:NURPROG(2)["NURSING" NURPROG(2)=" "_NURPROG(2) S ^TMP("NURA",$J,NURFAC(2),NURPROG(2),NL1)=""
- S NL1(0)=2,NL1(1)=1,SW=0 F NOD=0:0 S NOD=$O(^NURSF(211.8,"B",NO,NOD)) Q:NOD="" D S NL1(0)=NL1(0)+2,NL1(1)=NL1(1)+2,SW=0
- . S $P(^TMP("NURA",$J,NURFAC(2),NURPROG(2),NL1),"^",NL1(1))=$S('$D(^NURSF(211.8,NOD,0)):0,$P(^(0),"^",2)'="":$P(^(0),"^",2)_"^"_$$BUDCAT^NURSUT1(NOD),1:0)
- . I $D(^NURSF(211.8,NOD,0)) D GET2 S DA=0 F S DA=$O(^NURSF(211.8,NOD,1,DA)) Q:DA'>0 I $D(^NURSF(211.8,NOD,1,DA,0)),$P(^(0),"^")'>DT,'+$P(^(0),"^",6)!'(+$P(^(0),"^",6)<DT) D I 'SW D GET7
- . . S Z=$O(^NURSF(210,"B",+$P(^NURSF(211.8,NOD,1,DA,0),U,2),0)),SW=$S(Z="":1,$P($G(^NURSF(210,Z,0)),U,2)'="A":1,1:0)
- . . Q
- . Q
- Q
- GET2 S (Y,NBFTE,NAFTE)=0 F S Y=$O(^NURSF(211.8,NOD,2,"B",Y)) Q:Y'>0 D
- . S NURZ=0 F S NURZ=$O(^NURSF(211.8,NOD,2,"B",Y,NURZ)) Q:NURZ'>0 S:$D(^NURSF(211.8,NOD,2,NURZ,0)) NBFTE=$P(^(0),"^",2),NPOS=$S($P(^(0),"^")'="":$P(^(0),"^"),1:"")
- . D GOT S NBFTE=0
- Q
- GET7 S NPOS="",NAFTE=0,NDATA=^NURSF(211.8,NOD,1,DA,0),Z=$P(NDATA,"^",2) S:+Z Y=$O(^NURSF(210,"B",Z,0)) Q:'+Z!('Y) S NPOS=$P(NDATA,"^",3),NAFTE=$P(NDATA,"^",4)
- GOT S X=NPOS,NPOS=$S(NPOS="":"",'$D(^NURSF(211.3,NPOS,0)):"",1:$P(^(0),"^",2)),NPRI="" S:X NPRI=$S($D(^NURSF(211.3,X,0))&$P(^(0),"^",3)'="":$P(^(0),"^",3),1:""),NPO=$S($P(^(0),"^",5)'="":$P(^(0),"^",5),1:"")
- Q:NPRI="" S:NPOS="" NPOS=$P(IOM," ",1,30)
- I $D(^TMP("NURA",$J,NURFAC(2),NURPROG(2),NL1,NPRI)) S:$P(^(NPRI),"^",3)="" $P(^(NPRI),"^",3)=0 S $P(^(NPRI),"^",3)=$P(^(NPRI),"^",3)+NAFTE Q
- S ^TMP("NURA",$J,NURFAC(2),NURPROG(2),NL1,NPRI)=NPO_";"_NPOS_"^"_NBFTE_"^"_NAFTE
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURAR11A 3524 printed Mar 13, 2025@21:24:42 Page 2
- NURAR11A ;HIRMFO/MD-COMPARISON REPORT BY LOCATION ;7/10/97
- +1 ;;4.0;NURSING SERVICE;**2,32**;Apr 25, 1997
- +2 SET X=$GET(^DIC(213.9,1,"OFF"))
- if X=""!(X=1)
- QUIT
- +3 SET (NURQUEUE,NUROUT)=0
- +4 DO EN1^NURSAUTL
- if NUROUT
- GOTO QUIT
- +5 IF $GET(NURMDSW)
- WRITE !
- SET DIC(0)="AEQZ"
- SET NURPLSCR=1
- DO EN5^NURSAGSP
- KILL NURPLSCR
- if $GET(NUROUT)
- GOTO QUIT
- +6 IF '$GET(NURMDSW)
- IF $GET(NURPLSW)
- SET NURPLSCR=1
- DO PRD^NURSAGSP
- KILL NURPLSCR
- if (NUROUT)
- GOTO QUIT
- +7 WRITE !
- DO EN1^NURSAGSP
- if $GET(NUROUT)
- GOTO QUIT
- +8 WRITE !
- if NURHOSP
- SET NWRD=""
- +9 SET ZTRTN="START^NURAR11A"
- DO EN7^NURSUT0
- if POP!($DATA(ZTSK))
- GOTO QUIT
- START ;
- +1 KILL ^TMP("NURA",$JOB)
- +2 WRITE !
- IF 'NURHOSP
- SET NURSX=""
- FOR
- SET NURSX=$ORDER(NURSNLOC(NURSX))
- if NURSX=""
- QUIT
- SET NWRD=0
- FOR
- SET NWRD=$ORDER(NURSNLOC(NURSX,NWRD))
- if NWRD'>0
- QUIT
- if $SELECT('$DATA(^NURSF(211.4,NWRD,"I"))
- DO GETNODE
- +3 IF NURHOSP
- FOR NWRD=0:0
- SET NWRD=$ORDER(^NURSF(211.4,NWRD))
- if NWRD'>0
- QUIT
- if $SELECT('$DATA(^NURSF(211.4,NWRD,"I"))
- DO GETNODE
- +4 IF NURSZAP=7
- Begin DoDot:1
- +5 SET NPWARD=$ORDER(NURSZLO(0))
- DO EN6^NURSAUTL
- +6 SET Z=$ORDER(^TMP("NURA",$JOB,Z))
- if Z=""
- QUIT
- SET X=""
- FOR Y=0:0
- SET X=$ORDER(^TMP("NURA",$JOB,Z,X))
- if X=""
- QUIT
- if $SELECT(NPWARD=""
- KILL ^TMP("NURA",$JOB,Z,X)
- +7 KILL X,Y
- QUIT
- +8 QUIT
- End DoDot:1
- +9 SET (NURQUIT,NURSW1,NURPAGE,NAFTE,NTOTA,NTOTB,NTRB,NTRA,NTRAT,NTLB,NTLA,NTLAT,NTNA,NTNB,NTNAT,NTCA,NTCB,NTCAT,NTAA,NTAB,NTAAT,NTOA,NTOB,NTOAT)=0
- +10 USE IO
- DO EN1^NURAR110
- WRITE !
- QUIT KILL ^TMP("NURA",$JOB)
- DO CLOSE^NURSUT1
- DO ^NURAKILL
- +1 QUIT
- GETNODE ;
- +1 SET NPWARD=NWRD
- DO EN6^NURSAUTL
- SET NL1=NPWARD
- SET NO=$SELECT('$DATA(^NURSF(211.4,NWRD,0)):"",$PIECE(^(0),"^")'="":$PIECE(^(0),"^"),1:"")
- if NL1="MASONLY"!(NL1="MAS ONLY")
- QUIT
- +2 IF NURMDSW
- SET NURFAC(2)=$$EN12^NURSUT3($GET(NWRD))
- if $GET(NURFAC(2))=""
- QUIT
- +3 IF '$TEST
- SET NURFAC(2)=" BLANK"
- +4 IF NURPLSW
- SET X=+$PIECE($GET(^NURSF(211.4,NWRD,1)),U,4)
- SET NURPROG(2)=$SELECT($$GET1^DIQ(212.7,X,.01,"I")'="":$$GET1^DIQ(212.7,X,.01,"I"),1:" BLANK")
- +5 IF '$TEST
- SET NURPROG(2)=" BLANK"
- +6 IF NURMDSW
- IF '$GET(NURFAC)
- IF $GET(NURFAC(1))'=" BLANK"
- if NURFAC(1)'=NURFAC(2)
- QUIT
- +7 IF NURPLSW
- IF '$GET(NURPROG)
- IF $GET(NURPROG(2))'=" BLANK"
- IF $GET(NURPROG(1))'=""
- if NURPROG(1)'=NURPROG(2)
- QUIT
- +8 if NURPROG(2)["NURSING"
- SET NURPROG(2)=" "_NURPROG(2)
- SET ^TMP("NURA",$JOB,NURFAC(2),NURPROG(2),NL1)=""
- +9 SET NL1(0)=2
- SET NL1(1)=1
- SET SW=0
- FOR NOD=0:0
- SET NOD=$ORDER(^NURSF(211.8,"B",NO,NOD))
- if NOD=""
- QUIT
- Begin DoDot:1
- +10 SET $PIECE(^TMP("NURA",$JOB,NURFAC(2),NURPROG(2),NL1),"^",NL1(1))=$SELECT('$DATA(^NURSF(211.8,NOD,0)):0,$PIECE(^(0),"^",2)'="":$PIECE(^(0),"^",2)_"^"_$$BUDCAT^NURSUT1(NOD),1:0)
- +11 IF $DATA(^NURSF(211.8,NOD,0))
- DO GET2
- SET DA=0
- FOR
- SET DA=$ORDER(^NURSF(211.8,NOD,1,DA))
- if DA'>0
- QUIT
- IF $DATA(^NURSF(211.8,NOD,1,DA,0))
- IF $PIECE(^(0),"^")'>DT
- IF '+$PIECE(^(0),"^",6)!'(+$PIECE(^(0),"^",6)<DT)
- Begin DoDot:2
- +12 SET Z=$ORDER(^NURSF(210,"B",+$PIECE(^NURSF(211.8,NOD,1,DA,0),U,2),0))
- SET SW=$SELECT(Z="":1,$PIECE($GET(^NURSF(210,Z,0)),U,2)'="A":1,1:0)
- +13 QUIT
- End DoDot:2
- IF 'SW
- DO GET7
- +14 QUIT
- End DoDot:1
- SET NL1(0)=NL1(0)+2
- SET NL1(1)=NL1(1)+2
- SET SW=0
- +15 QUIT
- GET2 SET (Y,NBFTE,NAFTE)=0
- FOR
- SET Y=$ORDER(^NURSF(211.8,NOD,2,"B",Y))
- if Y'>0
- QUIT
- Begin DoDot:1
- +1 SET NURZ=0
- FOR
- SET NURZ=$ORDER(^NURSF(211.8,NOD,2,"B",Y,NURZ))
- if NURZ'>0
- QUIT
- if $DATA(^NURSF(211.8,NOD,2,NURZ,0))
- SET NBFTE=$PIECE(^(0),"^",2)
- SET NPOS=$SELECT($PIECE(^(0),"^")'="":$PIECE(^(0),"^"),1:"")
- +2 DO GOT
- SET NBFTE=0
- End DoDot:1
- +3 QUIT
- GET7 SET NPOS=""
- SET NAFTE=0
- SET NDATA=^NURSF(211.8,NOD,1,DA,0)
- SET Z=$PIECE(NDATA,"^",2)
- if +Z
- SET Y=$ORDER(^NURSF(210,"B",Z,0))
- if '+Z!('Y)
- QUIT
- SET NPOS=$PIECE(NDATA,"^",3)
- SET NAFTE=$PIECE(NDATA,"^",4)
- GOT SET X=NPOS
- SET NPOS=$SELECT(NPOS="":"",'$DATA(^NURSF(211.3,NPOS,0)):"",1:$PIECE(^(0),"^",2))
- SET NPRI=""
- if X
- SET NPRI=$SELECT($DATA(^NURSF(211.3,X,0))&$PIECE(^(0),"^",3)'="":$PIECE(^(0),"^",3),1:"")
- SET NPO=$SELECT($PIECE(^(0),"^",5)'="":$PIECE(^(0),"^",5),1:"")
- +1 if NPRI=""
- QUIT
- if NPOS=""
- SET NPOS=$PIECE(IOM," ",1,30)
- +2 IF $DATA(^TMP("NURA",$JOB,NURFAC(2),NURPROG(2),NL1,NPRI))
- if $PIECE(^(NPRI),"^",3)=""
- SET $PIECE(^(NPRI),"^",3)=0
- SET $PIECE(^(NPRI),"^",3)=$PIECE(^(NPRI),"^",3)+NAFTE
- QUIT
- +3 SET ^TMP("NURA",$JOB,NURFAC(2),NURPROG(2),NL1,NPRI)=NPO_";"_NPOS_"^"_NBFTE_"^"_NAFTE
- +4 QUIT
