- NURSEPML ;HIRMFO/MD,FT-TRAINING REPORT BY LOCATION ;6/5/97
- ;;4.0;NURSING SERVICE;**2,3,10,12,13**;Apr 25, 1997
- EN1 S X=$G(^PRSE(452.7,1,"OFF")) Q:X=""!(X=1)
- S X=$G(^DIC(213.9,1,"OFF")) Q:X=""!(X=1)
- S (NURHOSP,NURQUEUE,NUROUT,NURSW1,NURPAGE,NUROUT)=0,NSW2=1
- D EN1^NURSAUTL G QUIT:$G(NUROUT)
- I NURPLSW=1 D EN13^NURSAGSP G:$G(NUROUT) QUIT
- I NURMDSW S DIC(0)="AEQMZ",NURPLSCR=1 D EN5^NURSAGSP G:$G(NUROUT) QUIT
- I NURMDSW=0,NURPLSW=1 S NURPLSCR=1 D PRD^NURSAGSP K NURPLSCR I $G(NUROUT) G QUIT
- D EN10^NURSUT3($G(DUZ)),DATSEL^NURSAGP2 G QUIT:$G(NUROUT) D INS^NURSAGP2 G QUIT:$G(NUROUT)
- I NURPLSW=0!($G(NURSEL(1))=1)!($G(NURSEL(1))="") W ! D EN1^NURSAGSP G QUIT:$G(NUROUT)
- I $G(NURSEL(1))=2 W ! D EN3^NURSAGSP G QUIT:$G(NUROUT)
- D EN5^NURSAGP1 G QUIT:$G(NUROUT)
- W ! S ZTDESC="Nursing Training Report by Location",ZTRTN="START^NURSEPML" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
- START ;
- K ^TMP("NURE",$J),^TMP("NURLOC",$J) S (HOLD,HOLD(1),HOLD(2),HOLD(3))=1,(PCNT,SCNT,RCNT,SHRS,SHRS("CON"),SHRS("CEU"),RHRS,RHRS("CON"),RHRS("CEU"),PHRS,PHRS("CON"),PHRS("CEU"))=0
- S NURS132=$S(IOM'<132:1,1:0) F NDA=0:0 S NDA=$O(^NURSF(211.8,"C",NDA)) Q:NDA'>0 F NURNODE4=0:0 S NURNODE4=$O(^NURSF(211.8,"C",NDA,NURNODE4)) Q:NURNODE4'>0 D
- .K NURNODE4(1),NURNODE4(2) Q:'$D(^NURSF(211.8,NURNODE4,0))
- .S NURNODE4(1)=+$P(^NURSF(211.8,NURNODE4,0),"^") Q:NURNODE4(1)'>0 Q:'$D(^NURSF(211.4,"B",NURNODE4(1)))
- .S NURNODE4(2)=$O(^NURSF(211.4,"B",NURNODE4(1),0)) Q:'$D(^NURSF(211.4,NURNODE4(2),"I")) Q:$E($P(^("I"),"^"))="I"
- .F NURNODE5=0:0 S NURNODE5=$O(^NURSF(211.8,"C",NDA,NURNODE4,NURNODE5)) Q:NURNODE5'>0 I $P($G(^NURSF(211.8,NURNODE4,1,NURNODE5,0)),U)'>DT&(('$P($G(^(0)),U,6))!($P($G(^(0)),U,6)'<DT)) D
- ..S DA=$O(^NURSF(210,"B",NDA,0)) I $P($G(^NURSF(210,+DA,0)),U,2)'="",$P($G(^(0)),U,2)'="R",$D(^VA(200,NDA,0)) W:$R(500)&$E(IOST)="C" "." D SORT
- ..Q
- .Q
- I $O(^TMP("NURE",$J,""))="",'$D(NURSNLOC) S NUROUT=1 S NURPROG=$S($G(NURPROG)=0:NURPROG(1),1:""),NURFAC=$S($G(NURFAC)=0:NURFAC(1),1:"") D NHDR^NURSEPL1 W !!,"THERE IS NO DATA FOR THIS REPORT"
- I $O(^TMP("NURE",$J,""))="",$D(NURSNLOC) S NUROUT=1 S NURPROG=$S($G(NURPROG)=0:NURPROG(1),1:""),NURFAC=$S($G(NURFAC)=0:NURFAC(1),1:"") D NHDR^NURSEPL1 S NL1="" F S NL1=$O(NURSNLOC(NL1)) Q:NL1="" D NODATA^NURSUT1
- I $O(^TMP("NURE",$J,""))'="",$D(NURSNLOC) S NURSPEC="" D I NURSW1=1 D ENDPG^NURSUT1 S NURSW1=0
- . S (NURY,NURZ,NURX)="" F S NURY=$O(^TMP("NURE",$J,"L",NURY)) Q:NURY="" F S NURZ=$O(^TMP("NURE",$J,"L",NURY,NURZ)) Q:NURZ="" F S NURX=$O(^TMP("NURE",$J,"L",NURY,NURZ,NURX)) Q:NURX="" S ^TMP("NURLOC",$J,NURX)=""
- . S NL1="" F S NL1=$O(NURSNLOC(NL1)) Q:NL1="" I '$D(^TMP("NURLOC",$J,NL1)) D
- . . S NURPROG=$S($G(NURPROG)=0:NURPROG(1),1:""),NURFAC=$S($G(NURFAC)=0:NURFAC(1),1:"") D:NURSW1=0 NHDR^NURSEPL1 D NODATA^NURSUT1
- . . Q
- . Q
- D NPRINT^NURSEPL1
- QUIT K ^TMP("NURE",$J) D CLOSE^NURSUT1,^NURSKILL
- K NATTEND,NMHOLD Q
- SORT ; SORT MI DATA
- Q:NURSZAP>7&(NURSZDA'=DA) S NURSZORT=1 D EN3^NURSAUTL:NURSZAP>6,EN2^NURSAUTL:NURSZORT&NURSZAP Q:'NURSZORT
- S NURNEN=$S($G(NURSEL(1))=2:1,1:3) D SETPROG^NURAAGS1,SETFAC^NURAAGS1
- W:$E(IOST)="C"&($R(2000)) "." S N1=$S($P(^VA(200,NDA,0),"^")="":"VA # "_NDA,1:$P(^(0),"^"))
- S NLO=$S($D(^NURSF(211.8,+NURNODE4,0)):$P(^(0),U),1:" BLANK")
- D EN2^NURSUT0 Q:$G(NPSPOS(1))="" S NURCAT=NPSPOS(1)
- S NPWARD=NLO D EN7^NURSAUTL Q:NPWARD="" S NL1=$E(NPWARD,1,10)
- S NURSPEC=$S($G(NURSEL(1))=2:$$CAT^NURSUT2(NPSPOS(1)),1:$E(NPWARD,1,10)),NURSPEC(1)=$S($G(NURSEL(1))=2:$E(NPWARD,1,10),1:$$CAT^NURSUT2(NPSPOS(1)))
- I $G(NURSEL(1))'=2,$G(NURHOSP)=0,'$D(NURSNLOC(NL1)) Q
- I $G(NURSEL(1))=2,'$D(^TMP("NURSCAT",$J,NPSPOS(1))) Q
- I NURMDSW,'$G(NURFAC),$G(NURFAC(1))'=$G(NURFAC(2)) Q
- I NURPLSW,'$G(NURPROG),$G(NURPROG(1))'=$G(NURPROG(2)) Q
- S:NURPROG(2)="NURSING" NURPROG(2)=" "_NURPROG(2)
- S NIC2="" F S NIC2=$O(^PRSE(452,"AA",NIC2)) Q:NIC2="" S NIC1="" F S NIC1=$O(^PRSE(452,"AA",NIC2,NDA,NIC1)) Q:NIC1="" D
- . I NURSEL'="A"&(NURSEL'=NIC2) Q
- . I NSW2'=1 S NCD=$O(^PRSE(452,"AA",NIC2,DA(1),NIC1,"")),DA(2)=$O(^PRSE(452,"AA",NIC2,DA(1),NIC1,NCD,"")) D SAVE
- . E F NCD1=0:0 S NCD1=$O(^PRSE(452,"AA",NIC2,NDA,NIC1,NCD1)) Q:NCD1'>0 F PDA=0:0 S PDA=$O(^PRSE(452,"AA",NIC2,NDA,NIC1,NCD1,PDA)) Q:PDA'>0 D SAVE
- . Q
- Q
- SAVE ;
- S:$G(NURSORT)="" NURSORT=1
- S NCD=$P($G(^PRSE(452,PDA,0)),U,3)
- I NCD<YRST!(NCD>YREND) Q
- I NSW2'=1 S ^TMP("NURE",$J,NURFAC(2),NURPROG(2),$E(NIC1,1,30),NCD,PDA)="" Q
- E I $D(NSPC)#2,'(NSPC=NIC1) Q
- S NURECLS(0)=$O(^PRSE(452.1,"B",NIC1,0))
- N X S X=$G(^TMP("NURE",$J,"L",NURFAC(2),NURPROG(2),NURSPEC,NIC1))
- I X="" S X=NURSORT,NURSORT=NURSORT+1,^TMP("NURE",$J,"L",NURFAC(2),NURPROG(2),NURSPEC,NIC1)=X
- S DATA=$G(^PRSE(452,PDA,0)),^TMP("NURE",$J,"L1",X,N1,NURSPEC(1),NCD,PDA)=$P($G(DATA),U,16)_U_$P($G(^PRSE(452,PDA,6)),U,2)_U_$P($G(DATA),U,21)_U_$P($G(DATA),U,6)_U_$P($G(DATA),U,10)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSEPML 4868 printed Mar 13, 2025@21:27:13 Page 2
- NURSEPML ;HIRMFO/MD,FT-TRAINING REPORT BY LOCATION ;6/5/97
- +1 ;;4.0;NURSING SERVICE;**2,3,10,12,13**;Apr 25, 1997
- EN1 SET X=$GET(^PRSE(452.7,1,"OFF"))
- if X=""!(X=1)
- QUIT
- +1 SET X=$GET(^DIC(213.9,1,"OFF"))
- if X=""!(X=1)
- QUIT
- +2 SET (NURHOSP,NURQUEUE,NUROUT,NURSW1,NURPAGE,NUROUT)=0
- SET NSW2=1
- +3 DO EN1^NURSAUTL
- if $GET(NUROUT)
- GOTO QUIT
- +4 IF NURPLSW=1
- DO EN13^NURSAGSP
- if $GET(NUROUT)
- GOTO QUIT
- +5 IF NURMDSW
- SET DIC(0)="AEQMZ"
- SET NURPLSCR=1
- DO EN5^NURSAGSP
- if $GET(NUROUT)
- GOTO QUIT
- +6 IF NURMDSW=0
- IF NURPLSW=1
- SET NURPLSCR=1
- DO PRD^NURSAGSP
- KILL NURPLSCR
- IF $GET(NUROUT)
- GOTO QUIT
- +7 DO EN10^NURSUT3($GET(DUZ))
- DO DATSEL^NURSAGP2
- if $GET(NUROUT)
- GOTO QUIT
- DO INS^NURSAGP2
- if $GET(NUROUT)
- GOTO QUIT
- +8 IF NURPLSW=0!($GET(NURSEL(1))=1)!($GET(NURSEL(1))="")
- WRITE !
- DO EN1^NURSAGSP
- if $GET(NUROUT)
- GOTO QUIT
- +9 IF $GET(NURSEL(1))=2
- WRITE !
- DO EN3^NURSAGSP
- if $GET(NUROUT)
- GOTO QUIT
- +10 DO EN5^NURSAGP1
- if $GET(NUROUT)
- GOTO QUIT
- +11 WRITE !
- SET ZTDESC="Nursing Training Report by Location"
- SET ZTRTN="START^NURSEPML"
- DO EN7^NURSUT0
- if POP!($DATA(ZTSK))
- GOTO QUIT
- START ;
- +1 KILL ^TMP("NURE",$JOB),^TMP("NURLOC",$JOB)
- SET (HOLD,HOLD(1),HOLD(2),HOLD(3))=1
- SET (PCNT,SCNT,RCNT,SHRS,SHRS("CON"),SHRS("CEU"),RHRS,RHRS("CON"),RHRS("CEU"),PHRS,PHRS("CON"),PHRS("CEU"))=0
- +2 SET NURS132=$SELECT(IOM'<132:1,1:0)
- FOR NDA=0:0
- SET NDA=$ORDER(^NURSF(211.8,"C",NDA))
- if NDA'>0
- QUIT
- FOR NURNODE4=0:0
- SET NURNODE4=$ORDER(^NURSF(211.8,"C",NDA,NURNODE4))
- if NURNODE4'>0
- QUIT
- Begin DoDot:1
- +3 KILL NURNODE4(1),NURNODE4(2)
- if '$DATA(^NURSF(211.8,NURNODE4,0))
- QUIT
- +4 SET NURNODE4(1)=+$PIECE(^NURSF(211.8,NURNODE4,0),"^")
- if NURNODE4(1)'>0
- QUIT
- if '$DATA(^NURSF(211.4,"B",NURNODE4(1)))
- QUIT
- +5 SET NURNODE4(2)=$ORDER(^NURSF(211.4,"B",NURNODE4(1),0))
- if '$DATA(^NURSF(211.4,NURNODE4(2),"I"))
- QUIT
- if $EXTRACT($PIECE(^("I"),"^"))="I"
- QUIT
- +6 FOR NURNODE5=0:0
- SET NURNODE5=$ORDER(^NURSF(211.8,"C",NDA,NURNODE4,NURNODE5))
- if NURNODE5'>0
- QUIT
- IF $PIECE($GET(^NURSF(211.8,NURNODE4,1,NURNODE5,0)),U)'>DT&(('$PIECE($GET(^(0)),U,6))!($PIECE($GET(^(0)),U,6)'<DT))
- Begin DoDot:2
- +7 SET DA=$ORDER(^NURSF(210,"B",NDA,0))
- IF $PIECE($GET(^NURSF(210,+DA,0)),U,2)'=""
- IF $PIECE($GET(^(0)),U,2)'="R"
- IF $DATA(^VA(200,NDA,0))
- if $RANDOM(500)&$EXTRACT(IOST)="C"
- WRITE "."
- DO SORT
- +8 QUIT
- End DoDot:2
- +9 QUIT
- End DoDot:1
- +10 IF $ORDER(^TMP("NURE",$JOB,""))=""
- IF '$DATA(NURSNLOC)
- SET NUROUT=1
- SET NURPROG=$SELECT($GET(NURPROG)=0:NURPROG(1),1:"")
- SET NURFAC=$SELECT($GET(NURFAC)=0:NURFAC(1),1:"")
- DO NHDR^NURSEPL1
- WRITE !!,"THERE IS NO DATA FOR THIS REPORT"
- +11 IF $ORDER(^TMP("NURE",$JOB,""))=""
- IF $DATA(NURSNLOC)
- SET NUROUT=1
- SET NURPROG=$SELECT($GET(NURPROG)=0:NURPROG(1),1:"")
- SET NURFAC=$SELECT($GET(NURFAC)=0:NURFAC(1),1:"")
- DO NHDR^NURSEPL1
- SET NL1=""
- FOR
- SET NL1=$ORDER(NURSNLOC(NL1))
- if NL1=""
- QUIT
- DO NODATA^NURSUT1
- +12 IF $ORDER(^TMP("NURE",$JOB,""))'=""
- IF $DATA(NURSNLOC)
- SET NURSPEC=""
- Begin DoDot:1
- +13 SET (NURY,NURZ,NURX)=""
- FOR
- SET NURY=$ORDER(^TMP("NURE",$JOB,"L",NURY))
- if NURY=""
- QUIT
- FOR
- SET NURZ=$ORDER(^TMP("NURE",$JOB,"L",NURY,NURZ))
- if NURZ=""
- QUIT
- FOR
- SET NURX=$ORDER(^TMP("NURE",$JOB,"L",NURY,NURZ,NURX))
- if NURX=""
- QUIT
- SET ^TMP("NURLOC",$JOB,NURX)=""
- +14 SET NL1=""
- FOR
- SET NL1=$ORDER(NURSNLOC(NL1))
- if NL1=""
- QUIT
- IF '$DATA(^TMP("NURLOC",$JOB,NL1))
- Begin DoDot:2
- +15 SET NURPROG=$SELECT($GET(NURPROG)=0:NURPROG(1),1:"")
- SET NURFAC=$SELECT($GET(NURFAC)=0:NURFAC(1),1:"")
- if NURSW1=0
- DO NHDR^NURSEPL1
- DO NODATA^NURSUT1
- +16 QUIT
- End DoDot:2
- +17 QUIT
- End DoDot:1
- IF NURSW1=1
- DO ENDPG^NURSUT1
- SET NURSW1=0
- +18 DO NPRINT^NURSEPL1
- QUIT KILL ^TMP("NURE",$JOB)
- DO CLOSE^NURSUT1
- DO ^NURSKILL
- +1 KILL NATTEND,NMHOLD
- QUIT
- SORT ; SORT MI DATA
- +1 if NURSZAP>7&(NURSZDA'=DA)
- QUIT
- SET NURSZORT=1
- if NURSZAP>6
- DO EN3^NURSAUTL
- if NURSZORT&NURSZAP
- DO EN2^NURSAUTL
- if 'NURSZORT
- QUIT
- +2 SET NURNEN=$SELECT($GET(NURSEL(1))=2:1,1:3)
- DO SETPROG^NURAAGS1
- DO SETFAC^NURAAGS1
- +3 if $EXTRACT(IOST)="C"&($RANDOM(2000))
- WRITE "."
- SET N1=$SELECT($PIECE(^VA(200,NDA,0),"^")="":"VA # "_NDA,1:$PIECE(^(0),"^"))
- +4 SET NLO=$SELECT($DATA(^NURSF(211.8,+NURNODE4,0)):$PIECE(^(0),U),1:" BLANK")
- +5 DO EN2^NURSUT0
- if $GET(NPSPOS(1))=""
- QUIT
- SET NURCAT=NPSPOS(1)
- +6 SET NPWARD=NLO
- DO EN7^NURSAUTL
- if NPWARD=""
- QUIT
- SET NL1=$EXTRACT(NPWARD,1,10)
- +7 SET NURSPEC=$SELECT($GET(NURSEL(1))=2:$$CAT^NURSUT2(NPSPOS(1)),1:$EXTRACT(NPWARD,1,10))
- SET NURSPEC(1)=$SELECT($GET(NURSEL(1))=2:$EXTRACT(NPWARD,1,10),1:$$CAT^NURSUT2(NPSPOS(1)))
- +8 IF $GET(NURSEL(1))'=2
- IF $GET(NURHOSP)=0
- IF '$DATA(NURSNLOC(NL1))
- QUIT
- +9 IF $GET(NURSEL(1))=2
- IF '$DATA(^TMP("NURSCAT",$JOB,NPSPOS(1)))
- QUIT
- +10 IF NURMDSW
- IF '$GET(NURFAC)
- IF $GET(NURFAC(1))'=$GET(NURFAC(2))
- QUIT
- +11 IF NURPLSW
- IF '$GET(NURPROG)
- IF $GET(NURPROG(1))'=$GET(NURPROG(2))
- QUIT
- +12 if NURPROG(2)="NURSING"
- SET NURPROG(2)=" "_NURPROG(2)
- +13 SET NIC2=""
- FOR
- SET NIC2=$ORDER(^PRSE(452,"AA",NIC2))
- if NIC2=""
- QUIT
- SET NIC1=""
- FOR
- SET NIC1=$ORDER(^PRSE(452,"AA",NIC2,NDA,NIC1))
- if NIC1=""
- QUIT
- Begin DoDot:1
- +14 IF NURSEL'="A"&(NURSEL'=NIC2)
- QUIT
- +15 IF NSW2'=1
- SET NCD=$ORDER(^PRSE(452,"AA",NIC2,DA(1),NIC1,""))
- SET DA(2)=$ORDER(^PRSE(452,"AA",NIC2,DA(1),NIC1,NCD,""))
- DO SAVE
- +16 IF '$TEST
- FOR NCD1=0:0
- SET NCD1=$ORDER(^PRSE(452,"AA",NIC2,NDA,NIC1,NCD1))
- if NCD1'>0
- QUIT
- FOR PDA=0:0
- SET PDA=$ORDER(^PRSE(452,"AA",NIC2,NDA,NIC1,NCD1,PDA))
- if PDA'>0
- QUIT
- DO SAVE
- +17 QUIT
- End DoDot:1
- +18 QUIT
- SAVE ;
- +1 if $GET(NURSORT)=""
- SET NURSORT=1
- +2 SET NCD=$PIECE($GET(^PRSE(452,PDA,0)),U,3)
- +3 IF NCD<YRST!(NCD>YREND)
- QUIT
- +4 IF NSW2'=1
- SET ^TMP("NURE",$JOB,NURFAC(2),NURPROG(2),$EXTRACT(NIC1,1,30),NCD,PDA)=""
- QUIT
- +5 IF '$TEST
- IF $DATA(NSPC)#2
- IF '(NSPC=NIC1)
- QUIT
- +6 SET NURECLS(0)=$ORDER(^PRSE(452.1,"B",NIC1,0))
- +7 NEW X
- SET X=$GET(^TMP("NURE",$JOB,"L",NURFAC(2),NURPROG(2),NURSPEC,NIC1))
- +8 IF X=""
- SET X=NURSORT
- SET NURSORT=NURSORT+1
- SET ^TMP("NURE",$JOB,"L",NURFAC(2),NURPROG(2),NURSPEC,NIC1)=X
- +9 SET DATA=$GET(^PRSE(452,PDA,0))
- SET ^TMP("NURE",$JOB,"L1",X,N1,NURSPEC(1),NCD,PDA)=$PIECE($GET(DATA),U,16)_U_$PIECE($GET(^PRSE(452,PDA,6)),U,2)_U_$PIECE($GET(DATA),U,21)_U_$PIECE($GET(DATA),U,6)_U_$PIECE($GET(DATA),U,10)
- +10 QUIT
