- NURA6C2 ;HIRMFO/MD,FT-SERVICE POSITION CERTIFICATION REPORT ;8/8/96 13:09
- ;;4.0;NURSING SERVICE;**13**;Apr 25, 1997
- Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
- W !
- S (NURQUEUE,NUROUT,NURQUIT)=0
- D EN1^NURSAUTL G QUIT:NUROUT
- I NURMDSW S DIC(0)="AEQZ",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
- W ! S NRNS=1 D EN2^NURSAGSP G QUIT:NUROUT
- D EN4^NURSAGP0 G QUIT:NUROUT
- W ! S ZTDESC="Service Position Certification Report",ZTRTN="START^NURA6C2" 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 P Q:NURQUIT
- Q
- P S NURPROG="" F S NURPROG=$O(^TMP($J,"L",NURFAC,NURPROG)) Q:NURPROG=""!(NURQUIT) D:NURSW1 HEADER Q:NURQUIT D P0 Q:NURQUIT
- Q
- P0 S NPRI="" F S NPRI=$O(^TMP($J,"L",NURFAC,NURPROG,NPRI)) Q:NPRI=""!(NURQUIT) D P1 Q:NURQUIT
- Q
- P1 S NSPN="" F S NSPN=$O(^TMP($J,"L",NURFAC,NURPROG,NPRI,NSPN)) Q:NSPN=""!(NURQUIT) D BRK1:NURSW1,P2 Q:NURQUIT
- Q
- P2 S NCRT="" F S NCRT=$O(^TMP($J,"L",NURFAC,NURPROG,NPRI,NSPN,NCRT)) Q:NCRT=""!(NURQUIT) S NURSORT=$G(^TMP($J,"L",NURFAC,NURPROG,NPRI,NSPN,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: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 POSITION: ",NSPN W !
- 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 POSITION" 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 EN2^NURAAGS0
- D NODATA^NURA9C1
- Q
- NURA6C2 ;HIRMFO/MD,FT-SERVICE POSITION CERTIFICATION REPORT ;8/8/96 13:09
- +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 WRITE !
- +4 SET (NURQUEUE,NUROUT,NURQUIT)=0
- +5 DO EN1^NURSAUTL
- IF NUROUT
- GOTO QUIT
- +6 IF NURMDSW
- SET DIC(0)="AEQZ"
- SET NURPLSCR=0
- DO EN5^NURSAGSP
- IF $GET(NUROUT)
- GOTO QUIT
- +7 IF NURMDSW=0
- IF NURPLSW=1
- SET NURPLSCR=0
- DO PRD^NURSAGSP
- KILL NURPLSCR
- IF $GET(NUROUT)
- GOTO QUIT
- +8 WRITE !
- SET NRNS=1
- DO EN2^NURSAGSP
- IF NUROUT
- GOTO QUIT
- +9 DO EN4^NURSAGP0
- IF NUROUT
- GOTO QUIT
- +10 WRITE !
- SET ZTDESC="Service Position Certification Report"
- SET ZTRTN="START^NURA6C2"
- 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 P
- IF NURQUIT
- QUIT
- +2 QUIT
- P SET NURPROG=""
- FOR
- SET NURPROG=$ORDER(^TMP($JOB,"L",NURFAC,NURPROG))
- IF NURPROG=""!(NURQUIT)
- QUIT
- IF NURSW1
- DO HEADER
- IF NURQUIT
- QUIT
- DO P0
- IF NURQUIT
- QUIT
- +1 QUIT
- P0 SET NPRI=""
- FOR
- SET NPRI=$ORDER(^TMP($JOB,"L",NURFAC,NURPROG,NPRI))
- IF NPRI=""!(NURQUIT)
- QUIT
- DO P1
- IF NURQUIT
- QUIT
- +1 QUIT
- P1 SET NSPN=""
- FOR
- SET NSPN=$ORDER(^TMP($JOB,"L",NURFAC,NURPROG,NPRI,NSPN))
- IF NSPN=""!(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,NPRI,NSPN,NCRT))
- IF NCRT=""!(NURQUIT)
- QUIT
- SET NURSORT=$GET(^TMP($JOB,"L",NURFAC,NURPROG,NPRI,NSPN,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
- 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 POSITION: ",NSPN
- WRITE !
- +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 POSITION"
- 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 EN2^NURAAGS0
- +1 DO NODATA^NURA9C1
- +2 QUIT
