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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURA9G 4135 printed Nov 22, 2024@17:28:42 Page 2
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
