AQAQMIS1.m

AQAQMIS1 ;IHS/ASU/RPL 4/17/89 ;MISSING CREDENTIALS REPORT-PART 2 ; 11/7/89  10:04 AM

 ;;STAFF CREDENTIALS Version 1.1;11/7/89

 ;

START S AQAQ80D="--------------------------------------------------------------------------------"

 S Y=DT X ^DD("DD") S AQAQDTP=Y

 S AQAQSTRT=""

 S AQAQ(3)="DEA Registration not on file."

 S AQAQ(4)="Internship Certificate Missing."

 S AQAQ(5)="Residency Certificate Missing."

 S AQAQ(6)="Professional degree not on file."

 S AQAQ(7)="Professional degree not verified."

 S AQAQ(8)="Bylaws Agreement not signed."

 S AQAQ(9)="Information Release not signed."

 S AQAQ(10)="Curriculum Vitae not on file."

 S AQAQ(11)="3 Letters of Reference not on file."

 S AQAQ(12)="No Medical License on file."

 S AQAQ(13)="Latest Medical License renewal not verified."

 S AQAQ(14)="No Health Status Statement on file."

 S AQAQ(15)="No Health Status Verification Statement on file."

 S AQAQ(16)="No Credentials approval date on file."

 S AQAQ(17)="No request for Clinical Privileges on file."

 S AQAQ(18)="No Clinical Privileges approval date on file for last request."

 S AQAQPG=0 D HEAD

 S AQAQNM="" F I=0:0 S AQAQNM=$O(^UTILITY($J,AQAQNM)) Q:AQAQNM=""!($D(AQAQQUIT))  D P1

 G QUIT

P1 S AQAQDFN="" F J=0:0 S AQAQDFN=$O(^UTILITY($J,AQAQNM,AQAQDFN)) Q:AQAQDFN=""!($D(AQAQQUIT))  D P15

 Q

P15 D:$Y>(IOSL-7) HEAD Q:$D(AQAQQUIT)

 S AQAQ=^UTILITY($J,AQAQNM,AQAQDFN)

 W !!,AQAQNM,?32,$P(AQAQ,"^",1),?60,$P(AQAQ,"^",2)

 W !!

 F I=1:1:18 I $P(AQAQ,"^",I) W ?10,AQAQ(I),! D:$Y>(IOSL-6) HEAD Q:$D(AQAQQUIT)

 Q

HEAD S AQAQPG=AQAQPG+1 I $D(AQAQSTRT) K AQAQSTRT G HEAD1

 I $E(IOST)="C",IO=IO(0) R X:DTIME I $E(X)="^"!('$T) S AQAQQUIT="" Q

HEAD1 W @IOF

 W AQAQSITE,?58,AQAQDTP,?72,"Page ",AQAQPG,!

 W !,?26,"MISSING CREDENTIALS REPORT"

 W !,?60,"Credentials",!

 W "Name",?32,"Staff Category",?60,"Application Date"

 W !,AQAQ80D,!

 Q

QUIT Q

AQAQMIS1  ;IHS/ASU/RPL 4/17/89 ;MISSING CREDENTIALS REPORT-PART 2 ; 11/7/89  10:04 AM

 +1       ;;STAFF CREDENTIALS Version 1.1;11/7/89

 +2       ;

START      SET AQAQ80D="--------------------------------------------------------------------------------"

 +1        SET Y=DT

           XECUTE ^DD("DD")

           SET AQAQDTP=Y

 +2        SET AQAQSTRT=""

 +3        SET AQAQ(3)="DEA Registration not on file."

 +4        SET AQAQ(4)="Internship Certificate Missing."

 +5        SET AQAQ(5)="Residency Certificate Missing."

 +6        SET AQAQ(6)="Professional degree not on file."

 +7        SET AQAQ(7)="Professional degree not verified."

 +8        SET AQAQ(8)="Bylaws Agreement not signed."

 +9        SET AQAQ(9)="Information Release not signed."

 +10       SET AQAQ(10)="Curriculum Vitae not on file."

 +11       SET AQAQ(11)="3 Letters of Reference not on file."

 +12       SET AQAQ(12)="No Medical License on file."

 +13       SET AQAQ(13)="Latest Medical License renewal not verified."

 +14       SET AQAQ(14)="No Health Status Statement on file."

 +15       SET AQAQ(15)="No Health Status Verification Statement on file."

 +16       SET AQAQ(16)="No Credentials approval date on file."

 +17       SET AQAQ(17)="No request for Clinical Privileges on file."

 +18       SET AQAQ(18)="No Clinical Privileges approval date on file for last request."

 +19       SET AQAQPG=0

           DO HEAD

 +20       SET AQAQNM=""

           FOR I=0:0

               SET AQAQNM=$ORDER(^UTILITY($JOB,AQAQNM))

               IF AQAQNM=""!($DATA(AQAQQUIT))

                   QUIT 

               DO P1

 +21       GOTO QUIT

P1         SET AQAQDFN=""

           FOR J=0:0

               SET AQAQDFN=$ORDER(^UTILITY($JOB,AQAQNM,AQAQDFN))

               IF AQAQDFN=""!($DATA(AQAQQUIT))

                   QUIT 

               DO P15

 +1        QUIT 

P15        IF $Y>(IOSL-7)

               DO HEAD

           IF $DATA(AQAQQUIT)

               QUIT 

 +1        SET AQAQ=^UTILITY($JOB,AQAQNM,AQAQDFN)

 +2        WRITE !!,AQAQNM,?32,$PIECE(AQAQ,"^",1),?60,$PIECE(AQAQ,"^",2)

 +3        WRITE !!

 +4        FOR I=1:1:18

               IF $PIECE(AQAQ,"^",I)

                   WRITE ?10,AQAQ(I),!

                   IF $Y>(IOSL-6)

                       DO HEAD

                   IF $DATA(AQAQQUIT)

                       QUIT 

 +5        QUIT 

HEAD       SET AQAQPG=AQAQPG+1

           IF $DATA(AQAQSTRT)

               KILL AQAQSTRT

               GOTO HEAD1

 +1        IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   READ X:DTIME

                   IF $EXTRACT(X)="^"!('$TEST)

                       SET AQAQQUIT=""

                       QUIT 

HEAD1      WRITE @IOF

 +1        WRITE AQAQSITE,?58,AQAQDTP,?72,"Page ",AQAQPG,!

 +2        WRITE !,?26,"MISSING CREDENTIALS REPORT"

 +3        WRITE !,?60,"Credentials",!

 +4        WRITE "Name",?32,"Staff Category",?60,"Application Date"

 +5        WRITE !,AQAQ80D,!

 +6        QUIT 

QUIT       QUIT