AQAQDUE.m

AQAQDUE ;IHS/ANMC/LJF - UTILITIES TO GET COMPUTER FIELDS; [ 05/27/92  11:24 AM ]

 ;;2.2;STAFF CREDENTIALS;;01 OCT 1992

 ;

LASTREAP ;***> SUBRTN to find last reappointment application date

 S (AQAQX,AQAQLAST,AQAQRE)=0

 F  S AQAQX=$O(^AQAQC(D0,"R","B",AQAQX)) Q:AQAQX=""  D

 .I '$O(^AQAQC(D0,"R","B",AQAQX)) S AQAQRE=AQAQX

 .Q:AQAQRE=0

 .S AQAQY=$O(^(AQAQX,0)),AQAQLAST=$P(^AQAQC(D0,"R",AQAQY,0),U,2)

 I AQAQRE=0 S AQAQLAST=$P(^AQAQC(D0,0),U,4)

 Q

 ;

 K ^UTILITY("DIQ1",$J)

 NEW DIC,DR,DA

 S AQAQLAST=999999 Q:'$O(^AQAQC(D0,"R",0))

 S DIC=9002165,DR=4,DA=D0 D EN^DIQ1

 S:$D(^UTILITY("DIQ1",$J,9002165,DA,4)) AQAQLAST=^(4)

 K ^UTILITY("DIQ1",$J)

 Q

 ;

 ;

LASTMLIC ;***> SUBRTN to find all medical license expiration date

 S (AQAQX,AQAQLAST,AQAQEX,AQAQF)=0

 F  S AQAQX=$O(^AQAQML(D0,1,"B",AQAQX)) Q:AQAQX=""  D

 .I '$O(^AQAQML(D0,1,"B",AQAQX)) S AQAQEX=AQAQX

 .Q:AQAQEX=0

 .S AQAQY=$O(^(AQAQX,0)),AQAQLAST=$P(^AQAQML(D0,1,AQAQY,0),U)

 I AQAQEX=0 S AQAQLAST=$P(^AQAQML(D0,0),U,4)  ;only one date

 Q

AQAQDUE   ;IHS/ANMC/LJF - UTILITIES TO GET COMPUTER FIELDS; [ 05/27/92  11:24 AM ]

 +1       ;;2.2;STAFF CREDENTIALS;;01 OCT 1992

 +2       ;

LASTREAP  ;***> SUBRTN to find last reappointment application date

 +1        SET (AQAQX,AQAQLAST,AQAQRE)=0

 +2        FOR 

               SET AQAQX=$ORDER(^AQAQC(D0,"R","B",AQAQX))

               IF AQAQX=""

                   QUIT 

               Begin DoDot:1

 +3                IF '$ORDER(^AQAQC(D0,"R","B",AQAQX))

                       SET AQAQRE=AQAQX

 +4                IF AQAQRE=0

                       QUIT 

 +5                SET AQAQY=$ORDER(^(AQAQX,0))

                   SET AQAQLAST=$PIECE(^AQAQC(D0,"R",AQAQY,0),U,2)

               End DoDot:1

 +6        IF AQAQRE=0

               SET AQAQLAST=$PIECE(^AQAQC(D0,0),U,4)

 +7        QUIT 

 +8       ;

 +9        KILL ^UTILITY("DIQ1",$JOB)

 +10       NEW DIC,DR,DA

 +11       SET AQAQLAST=999999

           IF '$ORDER(^AQAQC(D0,"R",0))

               QUIT 

 +12       SET DIC=9002165

           SET DR=4

           SET DA=D0

           DO EN^DIQ1

 +13       IF $DATA(^UTILITY("DIQ1",$JOB,9002165,DA,4))

               SET AQAQLAST=^(4)

 +14       KILL ^UTILITY("DIQ1",$JOB)

 +15       QUIT 

 +16      ;

 +17      ;

LASTMLIC  ;***> SUBRTN to find all medical license expiration date

 +1        SET (AQAQX,AQAQLAST,AQAQEX,AQAQF)=0

 +2        FOR 

               SET AQAQX=$ORDER(^AQAQML(D0,1,"B",AQAQX))

               IF AQAQX=""

                   QUIT 

               Begin DoDot:1

 +3                IF '$ORDER(^AQAQML(D0,1,"B",AQAQX))

                       SET AQAQEX=AQAQX

 +4                IF AQAQEX=0

                       QUIT 

 +5                SET AQAQY=$ORDER(^(AQAQX,0))

                   SET AQAQLAST=$PIECE(^AQAQML(D0,1,AQAQY,0),U)

               End DoDot:1

 +6       ;only one date

           IF AQAQEX=0

               SET AQAQLAST=$PIECE(^AQAQML(D0,0),U,4)

 +7        QUIT