- NURA6C1 ;HIRMFO/MD,FT-CATEGORY CERTIFICATION REPORT BY SVC. ;7/8/96
- ;;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,NUROUT,NURQUIT)=0
- D EN1^NURSAUTL G QUIT:NUROUT
- I NURMDSW S DIC(0)="AEQMZ",NURPLSCR=0 D EN5^NURSAGSP G QUIT:$G(NUROUT)
- I NURMDSW=0,NURPLSW=1 S NURPLSCR=0 D PRD^NURSAGSP K NURPLSCR I $G(NUROUT) G QUIT
- S ^TMP("NURSCAT",$J,"R")=""
- D EN4^NURSAGP0 G QUIT:NUROUT
- W ! S ZTDESC="Category Certification Report by Service",ZTRTN="START^NURA6C1",ZTSAVE("^TMP(""NURSCAT"",$J,")="" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
- START ;
- K ^TMP($J) U IO S (NURPAGE,NCT,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 P0 Q:NURQUIT
- Q
- P0 S NURPROG="" F S NURPROG=$O(^TMP($J,"L",NURFAC,NURPROG)) Q:NURPROG="" D:NURSW1 HEADER Q:NURQUIT D P1 Q:NURQUIT
- Q
- P1 S NURCAT="" F S NURCAT=$O(^TMP($J,"L",NURFAC,NURPROG,NURCAT)) Q:NURCAT="" D BRK1:NURSW1,P2 Q:NURQUIT
- Q
- P2 S NCRT="" F S NCRT=$O(^TMP($J,"L",NURFAC,NURPROG,NURCAT,NCRT)) Q:NCRT="" D P3 W ! Q:NURQUIT
- Q
- P3 S NCDT="" F S NCDT=$O(^TMP($J,"L",NURFAC,NURPROG,NURCAT,NCRT,NCDT)) Q:NCDT="" S NURSORT=$G(^TMP($J,"L",NURFAC,NURPROG,NURCAT,NCRT,NCDT)) I NURSORT D P4 Q:NURQUIT
- Q
- P4 S N1="" F S N1=$O(^TMP($J,"L1",NURSORT,N1)) Q:N1="" D:NCRT'=" BLANK" PRINT1 Q:NURQUIT
- Q
- PRINT1 I ($Y>(IOSL-10)!'NURSW1) D HEADER,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
- BRK1 Q:NURQUIT W !!?31,"SERVICE CATEGORY: ",$$CAT^NURSUT2(NURCAT),!
- Q
- S NURPAGE=NURPAGE+1 W:$E(IOST)="C"!(NURPAGE>1) @IOF
- I NURMDSW W ?$$CNTR^NURSUT2(NURFAC),$$FACL^NURSUT2(NURFAC)
- W !,"CERTIFICATION PROFILE BY SERVICE 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(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 EN1^NURAAGS0
- D NODATA^NURA9C1
- Q
- NURA6C1 ;HIRMFO/MD,FT-CATEGORY CERTIFICATION REPORT BY SVC. ;7/8/96
- +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,NUROUT,NURQUIT)=0
- +4 DO EN1^NURSAUTL
- IF NUROUT
- GOTO QUIT
- +5 IF NURMDSW
- SET DIC(0)="AEQMZ"
- SET NURPLSCR=0
- DO EN5^NURSAGSP
- IF $GET(NUROUT)
- GOTO QUIT
- +6 IF NURMDSW=0
- IF NURPLSW=1
- SET NURPLSCR=0
- DO PRD^NURSAGSP
- KILL NURPLSCR
- IF $GET(NUROUT)
- GOTO QUIT
- +7 SET ^TMP("NURSCAT",$JOB,"R")=""
- +8 DO EN4^NURSAGP0
- IF NUROUT
- GOTO QUIT
- +9 WRITE !
- SET ZTDESC="Category Certification Report by Service"
- SET ZTRTN="START^NURA6C1"
- SET ZTSAVE("^TMP(""NURSCAT"",$J,")=""
- DO EN7^NURSUT0
- IF POP!($DATA(ZTSK))
- GOTO QUIT
- START ;
- +1 KILL ^TMP($JOB)
- USE IO
- SET (NURPAGE,NCT,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 P0
- IF NURQUIT
- QUIT
- +2 QUIT
- P0 SET NURPROG=""
- FOR
- SET NURPROG=$ORDER(^TMP($JOB,"L",NURFAC,NURPROG))
- IF NURPROG=""
- QUIT
- IF NURSW1
- DO HEADER
- IF NURQUIT
- QUIT
- DO P1
- IF NURQUIT
- QUIT
- +1 QUIT
- P1 SET NURCAT=""
- FOR
- SET NURCAT=$ORDER(^TMP($JOB,"L",NURFAC,NURPROG,NURCAT))
- IF NURCAT=""
- QUIT
- IF NURSW1
- DO BRK1
- DO P2
- IF NURQUIT
- QUIT
- +1 QUIT
- P2 SET NCRT=""
- FOR
- SET NCRT=$ORDER(^TMP($JOB,"L",NURFAC,NURPROG,NURCAT,NCRT))
- IF NCRT=""
- QUIT
- DO P3
- WRITE !
- IF NURQUIT
- QUIT
- +1 QUIT
- P3 SET NCDT=""
- FOR
- SET NCDT=$ORDER(^TMP($JOB,"L",NURFAC,NURPROG,NURCAT,NCRT,NCDT))
- IF NCDT=""
- QUIT
- SET NURSORT=$GET(^TMP($JOB,"L",NURFAC,NURPROG,NURCAT,NCRT,NCDT))
- IF NURSORT
- DO P4
- IF NURQUIT
- QUIT
- +1 QUIT
- P4 SET N1=""
- FOR
- SET N1=$ORDER(^TMP($JOB,"L1",NURSORT,N1))
- IF N1=""
- QUIT
- IF NCRT'=" BLANK"
- DO PRINT1
- IF NURQUIT
- QUIT
- +1 QUIT
- PRINT1 IF ($Y>(IOSL-10)!'NURSW1)
- DO HEADER
- 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
- 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
- WRITE ?$$CNTR^NURSUT2(NURFAC),$$FACL^NURSUT2(NURFAC)
- +3 WRITE !,"CERTIFICATION PROFILE BY SERVICE 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(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 EN1^NURAAGS0
- +1 DO NODATA^NURA9C1
- +2 QUIT
