- NURA9C1 ;HIRMFO/MD,FT-SERVICE CATEGORY CERTIFICATION REPORT BY LOCATION ;8/9/96 10:04
- ;;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 (NURQUEUE,NURQUIT,NUROUT)=0
- D EN1^NURSAUTL G QUIT:$G(NUROUT)
- I NURMDSW=0,NURPLSW=1 S NURPLSCR=1 D PRD^NURSAGSP K NURPLSCR I $G(NUROUT) G QUIT
- I NURMDSW S DIC(0)="AEQZ",NURPLSCR=1 D EN5^NURSAGSP G QUIT:$G(NUROUT)
- W ! D EN1^NURSAGSP G QUIT:$G(NUROUT)
- S ^TMP("NURSCAT",$J,"R")=""
- D EN4^NURSAGP0 W ! G QUIT:$G(NUROUT)
- S ZTDESC="Nursing Service Category Certification Report by Location",ZTSAVE("^TMP(""NURSCAT"",$J,")="",ZTRTN="START^NURA9C1" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
- START ;
- K ^TMP($J),^TMP("NURLOC",$J) U IO S (NURPAGE,NURSW1)=0
- D SORT G:NUROUT QUIT
- D PRINT
- QUIT K ^TMP($J) D CLOSE^NURSUT1,^NURAKILL
- Q
- ; DETAIL LINE PRINT ROUTINE
- PRINT ;
- S NURFAC="" F S NURFAC=$O(^TMP($J,"L",NURFAC)) Q:NURFAC=""!(NURQUIT) D P Q:NURQUIT
- Q
- P S NURPROG="" F S NURPROG=$O(^TMP($J,"L",NURFAC,NURPROG)) Q:NURPROG=""!(NURQUIT) D P0 Q:NURQUIT
- Q
- P0 S NL1="" F S NL1=$O(^TMP($J,"L",NURFAC,NURPROG,NL1)) Q:NL1=""!(NURQUIT) D:NURSW1 HEADER,BRK Q:NURQUIT D P1 Q:NURQUIT
- Q
- P1 S NURCAT="" F S NURCAT=$O(^TMP($J,"L",NURFAC,NURPROG,NL1,NURCAT)) Q:NURCAT=""!(NURQUIT) D:NURSW1 BRK1 D P2 Q:NURQUIT
- Q
- P2 S NCRT="" F S NCRT=$O(^TMP($J,"L",NURFAC,NURPROG,NL1,NURCAT,NCRT)) Q:NCRT=""!(NURQUIT) S NURSORT=$G(^TMP($J,"L",NURFAC,NURPROG,NL1,NURCAT,NCRT)) I NURSORT D P4 Q:NURQUIT
- Q
- P4 S NCDT="" F S NCDT=$O(^TMP($J,"L1",NURSORT,NCDT)) Q:NCDT=""!(NURQUIT) D P5 W ! Q:NURQUIT
- Q
- P5 S N1="" F S N1=$O(^TMP($J,"L1",NURSORT,NCDT,N1)) Q:N1=""!(NURQUIT) D:NCRT'=" BLANK" PRINT1
- Q
- PRINT1 I ($Y>(IOSL-6)!'NURSW1) D HEADER,BRK,BRK1 Q:NURQUIT
- S NURSW1=1 S NURCTA="" S NSUB=$O(^NURSF(212.2,"C",$E(NCRT,1,30),"")),NURCTA=$S('$D(^NURSF(212.2,NSUB,0)):"",1:$P(^(0),"^",4))
- W:N1'=" BLANK" !,$E(N1,1,20)
- W ?24,$E(NCRT,1,30)
- W:NURCTA'=" BLANK" ?60,NURCTA
- S Y=NCDT D:+Y D^DIQ W:Y'=" BLANK" ?68,Y
- Q
- BRK Q:NURQUIT W !!?31,"LOCATION: ",NL1
- Q
- BRK1 Q:NURQUIT W !!?31,"SERVICE CATEGORY: ",$$CAT^NURSUT2(NURCAT),!
- Q
- S NURPAGE=NURPAGE+1 W:$E(IOST)="C"!(NURPAGE>1) @IOF
- I NURMDSW,$L($G(NURFAC))>1 W ?$$CNTR^NURSUT2(NURFAC),$$FACL^NURSUT2(NURFAC)
- W !!,"CERTIFICATION PROFILE BY LOCATION/SVC. CATEGORY" S X="T" D ^%DT D:+Y D^DIQ W ?58,Y,?72,"PAGE: ",NURPAGE
- W !!?60,"CERT.",?68,"DATE CERT." W !,"NAME",?24,"CERTIFICATION",?60,"AGENCY",?68,"EXPIRES" W !,$$REPEAT^XLFSTR("-",80)
- I $G(NURPLSW),$L($G(NURPROG))>1 N Z S Z=$$PROD^NURSUT2(NURPROG) W !?$$CNTR^NURSUT2(Z),$G(Z),!?$$CNTR^NURSUT2(Z),$$REPEAT^XLFSTR("-",$L(Z)+1)
- Q
- SORT W ! S NRPT=2 D EN3^NURAAGS0
- NODATA ;
- I $G(NSPC(1))'="" S Y=NSPC(1) D D^DIQ S NSPC(1)=Y
- I $G(NSPC(2))'="" S Y=NSPC(2) D D^DIQ S NSPC(2)=Y
- I $O(^TMP($J,""))="",'$D(NURSNLOC) S NUROUT=1,NURFAC=$S($G(NURFAC)=0:NURFAC(1),1:""),NURPROG=$S($G(NURPROG)=0:NURPROG(1),1:"") D
- . D HEADER W !!,"THERE'S NO DATA FOR "_$S($G(NSPC)'="":NSPC,1:"THIS REPORT")_$S($G(NSPC(1))'="":" FOR ",1:"")_$S($G(NSPC(1))'="":NSPC(1),1:"")_$S($G(NSPC(2))'="":" - "_NSPC(2),1:"")
- . Q
- I $O(^TMP($J,""))="",$D(NURSNLOC) S NUROUT=1,NURFAC=$S($G(NURFAC)=0:NURFAC(1),1:""),NURPROG=$S($G(NURPROG)=0:NURPROG(1),1:"") D
- . D HEADER S NL1="" F S NL1=$O(NURSNLOC(NL1)) Q:NL1="" W !!,"THERE IS NO "_NL1_" DATA FOR "_$S($G(NSPC)'="":NSPC,1:"THIS REPORT")_$S($G(NSPC(1))'="":" FOR ",1:"")_$S($G(NSPC(1))'="":NSPC(1),1:"")_$S($G(NSPC(2))'="":" - "_NSPC(2),1:"")
- . Q
- I $O(^TMP($J,""))'="",$D(NURSNLOC) S NURFAC=$S($G(NURFAC)=0:NURFAC(1),1:""),NURPROG=$S($G(NURPROG)=0:NURPROG(1),1:"") D I NURSW1=1 D ENDPG^NURSUT1 S NURSW1=0
- . 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)=""
- . S NL1="" F S NL1=$O(NURSNLOC(NL1)) Q:NL1="" I '$D(^TMP("NURLOC",$J,NL1)) D
- . . D:NURSW1=0 HEADER S NURSW1=1 W !!,"THERE IS NO "_NL1_" DATA FOR "_$S($G(NSPC)'="":NSPC,1:"THIS REPORT")_$S($G(NSPC(1))'="":" FOR ",1:"")_$S($G(NSPC(1))'="":NSPC(1),1:"")_$S($G(NSPC(2))'="":" - "_NSPC(2),1:"")
- . . Q
- . Q
- Q
- NURA9C1 ;HIRMFO/MD,FT-SERVICE CATEGORY CERTIFICATION REPORT BY LOCATION ;8/9/96 10:04
- +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 (NURQUEUE,NURQUIT,NUROUT)=0
- +4 DO EN1^NURSAUTL
- IF $GET(NUROUT)
- GOTO QUIT
- +5 IF NURMDSW=0
- IF NURPLSW=1
- SET NURPLSCR=1
- DO PRD^NURSAGSP
- KILL NURPLSCR
- IF $GET(NUROUT)
- GOTO QUIT
- +6 IF NURMDSW
- SET DIC(0)="AEQZ"
- SET NURPLSCR=1
- DO EN5^NURSAGSP
- IF $GET(NUROUT)
- GOTO QUIT
- +7 WRITE !
- DO EN1^NURSAGSP
- IF $GET(NUROUT)
- GOTO QUIT
- +8 SET ^TMP("NURSCAT",$JOB,"R")=""
- +9 DO EN4^NURSAGP0
- WRITE !
- IF $GET(NUROUT)
- GOTO QUIT
- +10 SET ZTDESC="Nursing Service Category Certification Report by Location"
- SET ZTSAVE("^TMP(""NURSCAT"",$J,")=""
- SET ZTRTN="START^NURA9C1"
- DO EN7^NURSUT0
- IF POP!($DATA(ZTSK))
- GOTO QUIT
- START ;
- +1 KILL ^TMP($JOB),^TMP("NURLOC",$JOB)
- USE IO
- SET (NURPAGE,NURSW1)=0
- +2 DO SORT
- IF NUROUT
- GOTO QUIT
- +3 DO PRINT
- QUIT KILL ^TMP($JOB)
- DO CLOSE^NURSUT1
- DO ^NURAKILL
- +1 QUIT
- +2 ; DETAIL LINE PRINT ROUTINE
- PRINT ;
- +1 SET NURFAC=""
- FOR
- SET NURFAC=$ORDER(^TMP($JOB,"L",NURFAC))
- IF NURFAC=""!(NURQUIT)
- QUIT
- DO P
- IF NURQUIT
- QUIT
- +2 QUIT
- P SET NURPROG=""
- FOR
- SET NURPROG=$ORDER(^TMP($JOB,"L",NURFAC,NURPROG))
- IF NURPROG=""!(NURQUIT)
- QUIT
- DO P0
- IF NURQUIT
- QUIT
- +1 QUIT
- P0 SET NL1=""
- FOR
- SET NL1=$ORDER(^TMP($JOB,"L",NURFAC,NURPROG,NL1))
- IF NL1=""!(NURQUIT)
- QUIT
- IF NURSW1
- DO HEADER
- DO BRK
- IF NURQUIT
- QUIT
- DO P1
- IF NURQUIT
- QUIT
- +1 QUIT
- P1 SET NURCAT=""
- FOR
- SET NURCAT=$ORDER(^TMP($JOB,"L",NURFAC,NURPROG,NL1,NURCAT))
- IF NURCAT=""!(NURQUIT)
- QUIT
- IF NURSW1
- DO BRK1
- DO P2
- IF NURQUIT
- QUIT
- +1 QUIT
- P2 SET NCRT=""
- FOR
- SET NCRT=$ORDER(^TMP($JOB,"L",NURFAC,NURPROG,NL1,NURCAT,NCRT))
- IF NCRT=""!(NURQUIT)
- QUIT
- SET NURSORT=$GET(^TMP($JOB,"L",NURFAC,NURPROG,NL1,NURCAT,NCRT))
- IF NURSORT
- DO P4
- IF NURQUIT
- QUIT
- +1 QUIT
- P4 SET NCDT=""
- FOR
- SET NCDT=$ORDER(^TMP($JOB,"L1",NURSORT,NCDT))
- IF NCDT=""!(NURQUIT)
- QUIT
- DO P5
- WRITE !
- IF NURQUIT
- QUIT
- +1 QUIT
- P5 SET N1=""
- FOR
- SET N1=$ORDER(^TMP($JOB,"L1",NURSORT,NCDT,N1))
- IF N1=""!(NURQUIT)
- QUIT
- IF NCRT'=" BLANK"
- DO PRINT1
- +1 QUIT
- PRINT1 IF ($Y>(IOSL-6)!'NURSW1)
- DO HEADER
- DO BRK
- DO BRK1
- IF NURQUIT
- QUIT
- +1 SET NURSW1=1
- SET NURCTA=""
- SET NSUB=$ORDER(^NURSF(212.2,"C",$EXTRACT(NCRT,1,30),""))
- SET NURCTA=$SELECT('$DATA(^NURSF(212.2,NSUB,0)):"",1:$PIECE(^(0),"^",4))
- +2 IF N1'=" BLANK"
- WRITE !,$EXTRACT(N1,1,20)
- +3 WRITE ?24,$EXTRACT(NCRT,1,30)
- +4 IF NURCTA'=" BLANK"
- WRITE ?60,NURCTA
- +5 SET Y=NCDT
- IF +Y
- DO D^DIQ
- IF Y'=" BLANK"
- WRITE ?68,Y
- +6 QUIT
- BRK IF NURQUIT
- QUIT
- WRITE !!?31,"LOCATION: ",NL1
- +1 QUIT
- BRK1 IF NURQUIT
- QUIT
- WRITE !!?31,"SERVICE CATEGORY: ",$$CAT^NURSUT2(NURCAT),!
- +1 QUIT
- IF $EXTRACT(IOST)="C"
- IF NURSW1
- DO ENDPG^NURSUT1
- IF NUROUT
- SET NURQUIT=+NUROUT
- IF NURQUIT
- QUIT
- +1 SET NURPAGE=NURPAGE+1
- IF $EXTRACT(IOST)="C"!(NURPAGE>1)
- WRITE @IOF
- +2 IF NURMDSW
- IF $LENGTH($GET(NURFAC))>1
- WRITE ?$$CNTR^NURSUT2(NURFAC),$$FACL^NURSUT2(NURFAC)
- +3 WRITE !!,"CERTIFICATION PROFILE BY LOCATION/SVC. CATEGORY"
- SET X="T"
- DO ^%DT
- IF +Y
- DO D^DIQ
- WRITE ?58,Y,?72,"PAGE: ",NURPAGE
- +4 WRITE !!?60,"CERT.",?68,"DATE CERT."
- WRITE !,"NAME",?24,"CERTIFICATION",?60,"AGENCY",?68,"EXPIRES"
- WRITE !,$$REPEAT^XLFSTR("-",80)
- +5 IF $GET(NURPLSW)
- IF $LENGTH($GET(NURPROG))>1
- NEW Z
- SET Z=$$PROD^NURSUT2(NURPROG)
- WRITE !?$$CNTR^NURSUT2(Z),$GET(Z),!?$$CNTR^NURSUT2(Z),$$REPEAT^XLFSTR("-",$LENGTH(Z)+1)
- +6 QUIT
- SORT WRITE !
- SET NRPT=2
- DO EN3^NURAAGS0
- NODATA ;
- +1 IF $GET(NSPC(1))'=""
- SET Y=NSPC(1)
- DO D^DIQ
- SET NSPC(1)=Y
- +2 IF $GET(NSPC(2))'=""
- SET Y=NSPC(2)
- DO D^DIQ
- SET NSPC(2)=Y
- +3 IF $ORDER(^TMP($JOB,""))=""
- IF '$DATA(NURSNLOC)
- SET NUROUT=1
- SET NURFAC=$SELECT($GET(NURFAC)=0:NURFAC(1),1:"")
- SET NURPROG=$SELECT($GET(NURPROG)=0:NURPROG(1),1:"")
- Begin DoDot:1
- +4 DO HEADER
- WRITE !!,"THERE'S NO DATA FOR "_$SELECT($GET(NSPC)'="":NSPC,1:"THIS REPORT")_$SELECT($GET(NSPC(1))'="":" FOR ",1:"")_$SELECT($GET(NSPC(1))'="":NSPC(1),1:"")_$SELECT($GET(NSPC(2))'="":" - "_NSPC(2),1:"")
- +5 QUIT
- End DoDot:1
- +6 IF $ORDER(^TMP($JOB,""))=""
- IF $DATA(NURSNLOC)
- SET NUROUT=1
- SET NURFAC=$SELECT($GET(NURFAC)=0:NURFAC(1),1:"")
- SET NURPROG=$SELECT($GET(NURPROG)=0:NURPROG(1),1:"")
- Begin DoDot:1
- +7 DO HEADER
- SET NL1=""
- FOR
- SET NL1=$ORDER(NURSNLOC(NL1))
- IF NL1=""
- QUIT
- WRITE !!,"THERE IS NO "_NL1_" DATA FOR "_$SELECT($GET(NSPC)'="":NSPC,1:"THIS REPORT")_$SELECT($GET(NSPC(1))'="":" FOR ",1:"")_$SELECT($GET(NSPC(1))'="":NSPC(1),1:"")_$SELECT($GET(NSPC(2))'="":" - "_NSPC(2),1:"")
- +8 QUIT
- End DoDot:1
- +9 IF $ORDER(^TMP($JOB,""))'=""
- IF $DATA(NURSNLOC)
- SET NURFAC=$SELECT($GET(NURFAC)=0:NURFAC(1),1:"")
- SET NURPROG=$SELECT($GET(NURPROG)=0:NURPROG(1),1:"")
- Begin DoDot:1
- +10 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)=""
- +11 SET NL1=""
- FOR
- SET NL1=$ORDER(NURSNLOC(NL1))
- IF NL1=""
- QUIT
- IF '$DATA(^TMP("NURLOC",$JOB,NL1))
- Begin DoDot:2
- +12 IF NURSW1=0
- DO HEADER
- SET NURSW1=1
- WRITE !!,"THERE IS NO "_NL1_" DATA FOR "_$SELECT($GET(NSPC)'="":NSPC,1:"THIS REPORT")_$SELECT($GET(NSPC(1))'="":" FOR ",1:"")_$SELECT($GET(NSPC(1))'="":NSPC(1),1:"")_$SELECT($GET(NSPC(2))'="":" - "_NSPC(2),1:"")
- +13 QUIT
- End DoDot:2
- +14 QUIT
- End DoDot:1
- IF NURSW1=1
- DO ENDPG^NURSUT1
- SET NURSW1=0
- +15 QUIT
