- NURA9C2 ;HIRMFO/MD,FT-SERVICE POSITION CERTIFICATION REPORT BY LOCATION ;8/9/96 10:13
- ;;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 S DIC(0)="AEQZ",NURPLSCR=1 D EN5^NURSAGSP G QUIT:$G(NUROUT)
- I NURMDSW=0,NURPLSW=1 S NURPLSCR=1 D PRD^NURSAGSP K NURPLSCR I $G(NUROUT) G QUIT
- W ! D EN1^NURSAGSP G QUIT:$G(NUROUT) W !
- S NRNS=1 D EN2^NURSAGSP G QUIT:$G(NUROUT)
- D EN4^NURSAGP0 W ! G QUIT:$G(NUROUT)
- S ZTDESC="Nursing Service Position Certification Report by Location",ZTRTN="START^NURA9C2" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
- START ;
- K ^TMP($J) U IO S (NURPAGE,NURSW1)=0,NSPN(1)=""
- D SORT G:$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 PA Q:NURQUIT
- Q
- PA S NURPROG="" F S NURPROG=$O(^TMP($J,"L",NURFAC,NURPROG)) Q:NURPROG=""!(NURQUIT) D PB Q:NURQUIT
- Q
- PB S NL1="" F S NL1=$O(^TMP($J,"L",NURFAC,NURPROG,NL1)) Q:NL1="" D:NURSW1 HEADER,BRK Q:NURQUIT D P0 Q:NURQUIT
- Q
- P0 S NPRI="" F S NPRI=$O(^TMP($J,"L",NURFAC,NURPROG,NL1,NPRI)) Q:NPRI="" D P1 Q:NURQUIT
- Q
- P1 S NSPN="" F S NSPN=$O(^TMP($J,"L",NURFAC,NURPROG,NL1,NPRI,NSPN)) Q:NSPN="" S NURSORT=$G(^TMP($J,"L",NURFAC,NURPROG,NL1,NPRI,NSPN)) I NURSORT D:NURSW1 BRK1 D P3 Q:NURQUIT
- Q
- P3 S NCRT="" F S NCRT=$O(^TMP($J,"L1",NURSORT,NCRT)) Q:NCRT="" D P4 Q:NURQUIT
- Q
- P4 S NCDT="" F S NCDT=$O(^TMP($J,"L1",NURSORT,NCRT,NCDT)) Q:NCDT="" D P5 Q:NURQUIT
- Q
- P5 S N1="" F S N1=$O(^TMP($J,"L1",NURSORT,NCRT,NCDT,N1)) Q:N1="" W ! D:NCRT'=" BLANK" PRINT1 Q:NURQUIT
- 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
- S NSPN(1)=NSPN Q
- BRK Q:NURQUIT W !!?31,"LOCATION: ",NL1
- Q
- BRK1 Q:NURQUIT W !!?31,"SERVICE POSITION: ",NSPN W !
- 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. 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($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 EN4^NURAAGS0
- D NODATA^NURA9C1
- Q
- NURA9C2 ;HIRMFO/MD,FT-SERVICE POSITION CERTIFICATION REPORT BY LOCATION ;8/9/96 10:13
- +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
- SET DIC(0)="AEQZ"
- SET NURPLSCR=1
- DO EN5^NURSAGSP
- IF $GET(NUROUT)
- GOTO QUIT
- +6 IF NURMDSW=0
- IF NURPLSW=1
- SET NURPLSCR=1
- DO PRD^NURSAGSP
- KILL NURPLSCR
- IF $GET(NUROUT)
- GOTO QUIT
- +7 WRITE !
- DO EN1^NURSAGSP
- IF $GET(NUROUT)
- GOTO QUIT
- WRITE !
- +8 SET NRNS=1
- DO EN2^NURSAGSP
- IF $GET(NUROUT)
- GOTO QUIT
- +9 DO EN4^NURSAGP0
- WRITE !
- IF $GET(NUROUT)
- GOTO QUIT
- +10 SET ZTDESC="Nursing Service Position Certification Report by Location"
- SET ZTRTN="START^NURA9C2"
- DO EN7^NURSUT0
- IF POP!($DATA(ZTSK))
- GOTO QUIT
- START ;
- +1 KILL ^TMP($JOB)
- USE IO
- SET (NURPAGE,NURSW1)=0
- SET NSPN(1)=""
- +2 DO SORT
- IF $GET(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 PA
- IF NURQUIT
- QUIT
- +2 QUIT
- PA SET NURPROG=""
- FOR
- SET NURPROG=$ORDER(^TMP($JOB,"L",NURFAC,NURPROG))
- IF NURPROG=""!(NURQUIT)
- QUIT
- DO PB
- IF NURQUIT
- QUIT
- +1 QUIT
- PB SET NL1=""
- FOR
- SET NL1=$ORDER(^TMP($JOB,"L",NURFAC,NURPROG,NL1))
- IF NL1=""
- QUIT
- IF NURSW1
- DO HEADER
- DO BRK
- IF NURQUIT
- QUIT
- DO P0
- IF NURQUIT
- QUIT
- +1 QUIT
- P0 SET NPRI=""
- FOR
- SET NPRI=$ORDER(^TMP($JOB,"L",NURFAC,NURPROG,NL1,NPRI))
- IF NPRI=""
- QUIT
- DO P1
- IF NURQUIT
- QUIT
- +1 QUIT
- P1 SET NSPN=""
- FOR
- SET NSPN=$ORDER(^TMP($JOB,"L",NURFAC,NURPROG,NL1,NPRI,NSPN))
- IF NSPN=""
- QUIT
- SET NURSORT=$GET(^TMP($JOB,"L",NURFAC,NURPROG,NL1,NPRI,NSPN))
- IF NURSORT
- IF NURSW1
- DO BRK1
- DO P3
- IF NURQUIT
- QUIT
- +1 QUIT
- P3 SET NCRT=""
- FOR
- SET NCRT=$ORDER(^TMP($JOB,"L1",NURSORT,NCRT))
- IF NCRT=""
- QUIT
- DO P4
- IF NURQUIT
- QUIT
- +1 QUIT
- P4 SET NCDT=""
- FOR
- SET NCDT=$ORDER(^TMP($JOB,"L1",NURSORT,NCRT,NCDT))
- IF NCDT=""
- QUIT
- DO P5
- IF NURQUIT
- QUIT
- +1 QUIT
- P5 SET N1=""
- FOR
- SET N1=$ORDER(^TMP($JOB,"L1",NURSORT,NCRT,NCDT,N1))
- IF N1=""
- QUIT
- WRITE !
- IF NCRT'=" BLANK"
- DO PRINT1
- IF NURQUIT
- QUIT
- +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 SET NSPN(1)=NSPN
- QUIT
- BRK IF NURQUIT
- QUIT
- WRITE !!?31,"LOCATION: ",NL1
- +1 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
- IF $LENGTH($GET(NURFAC))>1
- WRITE ?$$CNTR^NURSUT2(NURFAC),$$FACL^NURSUT2(NURFAC)
- +3 WRITE !!,"CERTIFICATION PROFILE BY LOCATION/SVC. 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($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 EN4^NURAAGS0
- +1 DO NODATA^NURA9C1
- +2 QUIT
