- NURA9G ;HIRMFO/MD,RM,FT-LICENSE PROFILE BY LOCATION ;8/9/96 10:50
- ;;4.0;NURSING SERVICE;**13**;Apr 25, 1997
- Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
- S (NURPLSW,NURPAGE,NURSW1,NUROUT,NURMDSW,NURQUEUE)=0
- D EN1^NURSAUTL G QUIT:$G(NUROUT)
- D EN9^NURSAGSP
- I NURMDSW S DIC(0)="AEMQZ",NURPLSCR=1 D EN5^NURSAGSP K NURPLSCR I $G(NUROUT) G QUIT
- I NURMDSW=0,NURPLSW=1 S NURPLSCR=1 D PRD^NURSAGSP K NURPLSCR I $G(NUROUT) G QUIT
- W ! D EN1^NURSAGSP G:$G(NUROUT) QUIT
- D EN3^NURSAGSP G:$G(NUROUT) QUIT
- D EN7^NURSAGP0 W ! G QUIT:$G(NUROUT)
- D EN10^NURSAGSP W ! G QUIT:$G(NUROUT)
- S ZTDESC="Nursing License Profile by Location",ZTRTN="START^NURA9G" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
- START ;
- K ^TMP($J),^TMP("NURLOC",$J) U IO
- D SORT D:'$G(NUROUT) NPRINT
- QUIT K ^TMP($J) D CLOSE^NURSUT1,^NURAKILL
- Q
- NPRINT S NURFAC(2)="" F S NURFAC(2)=$O(^TMP($J,"L",NURFAC(2))) Q:NURFAC(2)=""!$G(NUROUT) D NL Q:$G(NUROUT)
- Q
- NL S NURPROG(4)="" F S NURPROG(4)=$O(^TMP($J,"L",NURFAC(2),NURPROG(4))) Q:NURPROG(4)=""!$G(NUROUT) D NM Q:$G(NUROUT)
- Q
- NM S NL1="" F S NL1=$O(^TMP($J,"L",NURFAC(2),NURPROG(4),NL1)) Q:NL1=""!$G(NUROUT) D NHDR Q:$G(NUROUT) S NURCAT(1)=$O(^TMP($J,"L",NURFAC(2),NURPROG(4),NL1,"")) D NN Q:$G(NUROUT)
- Q
- NN Q:NURCAT(1)="" S NURCAT="" F S NURCAT=$O(^TMP($J,"L",NURFAC(2),NURPROG(4),NL1,NURCAT)) Q:NURCAT=""!$G(NUROUT) D NO Q:$G(NUROUT)
- Q
- NO S NLDT="" F S NLDT=$O(^TMP($J,"L",NURFAC(2),NURPROG(4),NL1,NURCAT,NLDT)) Q:NLDT=""!$G(NUROUT) S NURSORT=$G(^(NLDT)) I NURSORT D NP Q:$G(NUROUT)
- Q
- NP S N1="" F S N1=$O(^TMP($J,"L1",NURSORT,N1)) Q:N1=""!$G(NUROUT) S D0=$E(NLDT,8),NLDTPR=$E(NLDT,1,7) F DA=0:0 S DA=$O(^TMP($J,"L1",NURSORT,N1,DA)) Q:DA'>0 D NPPRINT Q:$G(NUROUT)
- Q
- NPPRINT I ($Y>(IOSL-6)) D NHDR Q:$G(NUROUT)
- S:'NURSW1 NURSW1=1
- W ! W:NURCAT(1)'=NURCAT !
- W:N1'=" BLANK" ?2,$E(N1,1,20)
- W:NURCAT'=" BLANK" ?28,$$CAT^NURSUT2(NURCAT) S NURCAT(1)=NURCAT
- I $D(^VA(200,+^NURSF(210,DA,0),1)),$P(^(1),"^",9)'="" S M=$P(^(1),"^",9) W ?36,$E(M,1,3),"-",$E(M,4,5),"-",$E(M,6,9)
- I NLDTPR'[" BLANK" S Y=NLDTPR D:+Y D^DIQ W ?49,Y
- I D0'="",$D(^NURSF(210,+DA,4,D0,0)),$P(^(0),"^",1)'="",$D(^DIC(5,$P(^NURSF(210,DA,4,D0,0),"^",1),0)),$P(^(0),"^",2)'="" W ?62,$P(^(0),"^",2)
- I D0'="",$D(^NURSF(210,+DA,4,D0,0)),$P(^(0),"^",2)'="" W ?68,$P(^(0),"^",2)
- Q
- NHDR I 'NURQUEUE,NURSW1,$E(IOST)="C" D ENDPG^NURSUT1 Q:$G(NUROUT)
- S NURPAGE=NURPAGE+1 W:$E(IOST)="C"!(NURPAGE>1) @IOF
- I $G(NURMDSW) W !,?35,$S($G(NURFAC(2))=" BLANK":"NO FACILITY",1:NURFAC(2))
- W !,"LICENSE PROFILE BY LOCATION" S X="T" D ^%DT D:+Y D^DIQ W ?56,Y,?72,"PAGE: ",NURPAGE
- W !!,?49,"EXPIRATION",?62,"STATE",?68,"PROFESSIONAL"
- W !,?28,"SVC",?49,"DATE OF",?62,"ISS.",?68,"LICENSE"
- W !,?2,"NAME",?28,"CAT.",?36,"SSN",?49,"LICENSE",?62,"LIC.",?68,"NUMBER"
- W !,$$REPEAT^XLFSTR("-",80)
- D:$G(NURPLSW) BRK1 D BRK
- Q
- SORT W ! S NRPT=8 D EN3^NURAAGS0
- S (NURY,NURZ,NURX)="" F S NURY=$O(^TMP($J,"L",NURY)) Q:NURY="" F S NURZ=$O(^TMP($J,"L",NURY,NURZ)) Q:NURZ="" F S NURX=$O(^TMP($J,"L",NURY,NURZ,NURX)) Q:NURX="" S ^TMP("NURLOC",$J,NURX)=""
- I $O(^TMP($J,""))="",'$D(NURSNLOC) S NUROUT=1 S NURPROG(4)=$S($G(NURPROG)=0:NURPROG(1),1:""),NURFAC(2)=$S($G(NURFAC)=0:NURFAC(1),1:"") D NHDR W !!,"THERE IS NO DATA FOR THIS REPORT"
- I $O(^TMP($J,""))="",$D(NURSNLOC) S NUROUT=1 S NURPROG(4)=$S($G(NURPROG)=0:NURPROG(1),1:""),NURFAC(2)=$S($G(NURFAC)=0:NURFAC(1),1:"") D NHDR S NL1="" F S NL1=$O(NURSNLOC(NL1)) Q:NL1="" D NODATA^NURSUT1
- I $O(^TMP($J,""))'="",$D(NURSNLOC) D I NURSW1=1 D ENDPG^NURSUT1 S NURSW1=0
- . S NL1="" F S NL1=$O(NURSNLOC(NL1)) Q:NL1="" I '$D(^TMP("NURLOC",$J,NL1)) D
- . . S NURPROG(4)=$S($G(NURPROG)=0:NURPROG(1),1:""),NURFAC(2)=$S($G(NURFAC)=0:NURFAC(1),1:"") I '$D(^TMP("NURLOC",$J,NL1)) D:NURSW1=0 NHDR S NURSW1=1 D NODATA^NURSUT1
- . . Q
- . Q
- Q
- BRK I $G(NURFAC(2))'="",$G(NL1)'="",$D(^TMP("NURLOC",$J,NL1)) W !,"LOCATION: ",NL1,!
- Q
- BRK1 I $G(NURPROG(4))'="",$G(NURPROG(4))'="" W !?$$CNTR^NURSUT2(NURPROG(4)),$S(NURPROG(4)=" NURSING":$E(NURPROG(4),2,99),1:$G(NURPROG(4))) W !?$$CNTR^NURSUT2(NURPROG(4)),$$REPEAT^XLFSTR("-",$L(NURPROG(4))+1),!
- Q
- NURA9G ;HIRMFO/MD,RM,FT-LICENSE PROFILE BY LOCATION ;8/9/96 10:50
- +1 ;;4.0;NURSING SERVICE;**13**;Apr 25, 1997
- +2 IF '$DATA(^DIC(213.9,1,"OFF"))
- QUIT
- IF $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
- QUIT
- +3 SET (NURPLSW,NURPAGE,NURSW1,NUROUT,NURMDSW,NURQUEUE)=0
- +4 DO EN1^NURSAUTL
- IF $GET(NUROUT)
- GOTO QUIT
- +5 DO EN9^NURSAGSP
- +6 IF NURMDSW
- SET DIC(0)="AEMQZ"
- SET NURPLSCR=1
- DO EN5^NURSAGSP
- KILL NURPLSCR
- IF $GET(NUROUT)
- GOTO QUIT
- +7 IF NURMDSW=0
- IF NURPLSW=1
- SET NURPLSCR=1
- DO PRD^NURSAGSP
- KILL NURPLSCR
- IF $GET(NUROUT)
- GOTO QUIT
- +8 WRITE !
- DO EN1^NURSAGSP
- IF $GET(NUROUT)
- GOTO QUIT
- +9 DO EN3^NURSAGSP
- IF $GET(NUROUT)
- GOTO QUIT
- +10 DO EN7^NURSAGP0
- WRITE !
- IF $GET(NUROUT)
- GOTO QUIT
- +11 DO EN10^NURSAGSP
- WRITE !
- IF $GET(NUROUT)
- GOTO QUIT
- +12 SET ZTDESC="Nursing License Profile by Location"
- SET ZTRTN="START^NURA9G"
- DO EN7^NURSUT0
- IF POP!($DATA(ZTSK))
- GOTO QUIT
- START ;
- +1 KILL ^TMP($JOB),^TMP("NURLOC",$JOB)
- USE IO
- +2 DO SORT
- IF '$GET(NUROUT)
- DO NPRINT
- QUIT KILL ^TMP($JOB)
- DO CLOSE^NURSUT1
- DO ^NURAKILL
- +1 QUIT
- NPRINT SET NURFAC(2)=""
- FOR
- SET NURFAC(2)=$ORDER(^TMP($JOB,"L",NURFAC(2)))
- IF NURFAC(2)=""!$GET(NUROUT)
- QUIT
- DO NL
- IF $GET(NUROUT)
- QUIT
- +1 QUIT
- NL SET NURPROG(4)=""
- FOR
- SET NURPROG(4)=$ORDER(^TMP($JOB,"L",NURFAC(2),NURPROG(4)))
- IF NURPROG(4)=""!$GET(NUROUT)
- QUIT
- DO NM
- IF $GET(NUROUT)
- QUIT
- +1 QUIT
- NM SET NL1=""
- FOR
- SET NL1=$ORDER(^TMP($JOB,"L",NURFAC(2),NURPROG(4),NL1))
- IF NL1=""!$GET(NUROUT)
- QUIT
- DO NHDR
- IF $GET(NUROUT)
- QUIT
- SET NURCAT(1)=$ORDER(^TMP($JOB,"L",NURFAC(2),NURPROG(4),NL1,""))
- DO NN
- IF $GET(NUROUT)
- QUIT
- +1 QUIT
- NN IF NURCAT(1)=""
- QUIT
- SET NURCAT=""
- FOR
- SET NURCAT=$ORDER(^TMP($JOB,"L",NURFAC(2),NURPROG(4),NL1,NURCAT))
- IF NURCAT=""!$GET(NUROUT)
- QUIT
- DO NO
- IF $GET(NUROUT)
- QUIT
- +1 QUIT
- NO SET NLDT=""
- FOR
- SET NLDT=$ORDER(^TMP($JOB,"L",NURFAC(2),NURPROG(4),NL1,NURCAT,NLDT))
- IF NLDT=""!$GET(NUROUT)
- QUIT
- SET NURSORT=$GET(^(NLDT))
- IF NURSORT
- DO NP
- IF $GET(NUROUT)
- QUIT
- +1 QUIT
- NP SET N1=""
- FOR
- SET N1=$ORDER(^TMP($JOB,"L1",NURSORT,N1))
- IF N1=""!$GET(NUROUT)
- QUIT
- SET D0=$EXTRACT(NLDT,8)
- SET NLDTPR=$EXTRACT(NLDT,1,7)
- FOR DA=0:0
- SET DA=$ORDER(^TMP($JOB,"L1",NURSORT,N1,DA))
- IF DA'>0
- QUIT
- DO NPPRINT
- IF $GET(NUROUT)
- QUIT
- +1 QUIT
- NPPRINT IF ($Y>(IOSL-6))
- DO NHDR
- IF $GET(NUROUT)
- QUIT
- +1 IF 'NURSW1
- SET NURSW1=1
- +2 WRITE !
- IF NURCAT(1)'=NURCAT
- WRITE !
- +3 IF N1'=" BLANK"
- WRITE ?2,$EXTRACT(N1,1,20)
- +4 IF NURCAT'=" BLANK"
- WRITE ?28,$$CAT^NURSUT2(NURCAT)
- SET NURCAT(1)=NURCAT
- +5 IF $DATA(^VA(200,+^NURSF(210,DA,0),1))
- IF $PIECE(^(1),"^",9)'=""
- SET M=$PIECE(^(1),"^",9)
- WRITE ?36,$EXTRACT(M,1,3),"-",$EXTRACT(M,4,5),"-",$EXTRACT(M,6,9)
- +6 IF NLDTPR'[" BLANK"
- SET Y=NLDTPR
- IF +Y
- DO D^DIQ
- WRITE ?49,Y
- +7 IF D0'=""
- IF $DATA(^NURSF(210,+DA,4,D0,0))
- IF $PIECE(^(0),"^",1)'=""
- IF $DATA(^DIC(5,$PIECE(^NURSF(210,DA,4,D0,0),"^",1),0))
- IF $PIECE(^(0),"^",2)'=""
- WRITE ?62,$PIECE(^(0),"^",2)
- +8 IF D0'=""
- IF $DATA(^NURSF(210,+DA,4,D0,0))
- IF $PIECE(^(0),"^",2)'=""
- WRITE ?68,$PIECE(^(0),"^",2)
- +9 QUIT
- NHDR IF 'NURQUEUE
- IF NURSW1
- IF $EXTRACT(IOST)="C"
- DO ENDPG^NURSUT1
- IF $GET(NUROUT)
- QUIT
- +1 SET NURPAGE=NURPAGE+1
- IF $EXTRACT(IOST)="C"!(NURPAGE>1)
- WRITE @IOF
- +2 IF $GET(NURMDSW)
- WRITE !,?35,$SELECT($GET(NURFAC(2))=" BLANK":"NO FACILITY",1:NURFAC(2))
- +3 WRITE !,"LICENSE PROFILE BY LOCATION"
- SET X="T"
- DO ^%DT
- IF +Y
- DO D^DIQ
- WRITE ?56,Y,?72,"PAGE: ",NURPAGE
- +4 WRITE !!,?49,"EXPIRATION",?62,"STATE",?68,"PROFESSIONAL"
- +5 WRITE !,?28,"SVC",?49,"DATE OF",?62,"ISS.",?68,"LICENSE"
- +6 WRITE !,?2,"NAME",?28,"CAT.",?36,"SSN",?49,"LICENSE",?62,"LIC.",?68,"NUMBER"
- +7 WRITE !,$$REPEAT^XLFSTR("-",80)
- +8 IF $GET(NURPLSW)
- DO BRK1
- DO BRK
- +9 QUIT
- SORT WRITE !
- SET NRPT=8
- DO EN3^NURAAGS0
- +1 SET (NURY,NURZ,NURX)=""
- FOR
- SET NURY=$ORDER(^TMP($JOB,"L",NURY))
- IF NURY=""
- QUIT
- FOR
- SET NURZ=$ORDER(^TMP($JOB,"L",NURY,NURZ))
- IF NURZ=""
- QUIT
- FOR
- SET NURX=$ORDER(^TMP($JOB,"L",NURY,NURZ,NURX))
- IF NURX=""
- QUIT
- SET ^TMP("NURLOC",$JOB,NURX)=""
- +2 IF $ORDER(^TMP($JOB,""))=""
- IF '$DATA(NURSNLOC)
- SET NUROUT=1
- SET NURPROG(4)=$SELECT($GET(NURPROG)=0:NURPROG(1),1:"")
- SET NURFAC(2)=$SELECT($GET(NURFAC)=0:NURFAC(1),1:"")
- DO NHDR
- WRITE !!,"THERE IS NO DATA FOR THIS REPORT"
- +3 IF $ORDER(^TMP($JOB,""))=""
- IF $DATA(NURSNLOC)
- SET NUROUT=1
- SET NURPROG(4)=$SELECT($GET(NURPROG)=0:NURPROG(1),1:"")
- SET NURFAC(2)=$SELECT($GET(NURFAC)=0:NURFAC(1),1:"")
- DO NHDR
- SET NL1=""
- FOR
- SET NL1=$ORDER(NURSNLOC(NL1))
- IF NL1=""
- QUIT
- DO NODATA^NURSUT1
- +4 IF $ORDER(^TMP($JOB,""))'=""
- IF $DATA(NURSNLOC)
- Begin DoDot:1
- +5 SET NL1=""
- FOR
- SET NL1=$ORDER(NURSNLOC(NL1))
- IF NL1=""
- QUIT
- IF '$DATA(^TMP("NURLOC",$JOB,NL1))
- Begin DoDot:2
- +6 SET NURPROG(4)=$SELECT($GET(NURPROG)=0:NURPROG(1),1:"")
- SET NURFAC(2)=$SELECT($GET(NURFAC)=0:NURFAC(1),1:"")
- IF '$DATA(^TMP("NURLOC",$JOB,NL1))
- IF NURSW1=0
- DO NHDR
- SET NURSW1=1
- DO NODATA^NURSUT1
- +7 QUIT
- End DoDot:2
- +8 QUIT
- End DoDot:1
- IF NURSW1=1
- DO ENDPG^NURSUT1
- SET NURSW1=0
- +9 QUIT
- BRK IF $GET(NURFAC(2))'=""
- IF $GET(NL1)'=""
- IF $DATA(^TMP("NURLOC",$JOB,NL1))
- WRITE !,"LOCATION: ",NL1,!
- +1 QUIT
- BRK1 IF $GET(NURPROG(4))'=""
- IF $GET(NURPROG(4))'=""
- WRITE !?$$CNTR^NURSUT2(NURPROG(4)),$SELECT(NURPROG(4)=" NURSING":$EXTRACT(NURPROG(4),2,99),1:$GET(NURPROG(4)))
- WRITE !?$$CNTR^NURSUT2(NURPROG(4)),$$REPEAT^XLFSTR("-",$LENGTH(NURPROG(4))+1),!
- +1 QUIT
