Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AQAQNQ1

AQAQNQ1.m

Go to the documentation of this file. 
  1. AQAQNQ1 ;IHS/ANMC/LJF - MORE CREDENTIALS REPORTS; [ 04/03/95  7:37 AM ]
  1.  ;;2.2;STAFF CREDENTIALS;**2**;01 OCT 1992
  1.  ;
  1. MLIC ;EP;****> prints listing of all medical licenses due to expire
  1.  W @IOF,!!?20,"MEDICAL LICENSURES DUE TO EXPIRE",!!
  1.  W ?5,"This report will print a listing of all medical licenses"
  1.  W !,"that are due to expire and those already overdue."
  1.  W !,"The report will list the providers in alphabetical order.",!!
  1.  ;
  1.  K DIR S DIR(0)="N0^1:12",DIR("B")=1
  1.  S DIR("A")="Print Licenses to come due how many months from now?"
  1.  S DIR("?",1)="Enter 0 (zero) to see only those due NOW;"
  1.  S DIR("?",2)="Enter 1 to see those due in the coming month;"
  1.  S DIR("?",3)="Enter 2 to see those due in the next 2 months;"
  1.  S DIR("?",4)="And so on up to 12 months."
  1.  S DIR("?")="All reports include those currently OVERDUE"
  1.  D ^DIR G MEND:$D(DIRUT) S AQAQNUM=Y
  1.  S X1=DT,X2=Y*30 D C^%DTC S AQAQDUE=X
  1.  ;
  1.  ;***> select type of report
  1. TYPE W ! K DIR S DIR("A",1)="Select Sorting Order for Report:"
  1.  S DIR("A",2)="     1.  ALPHABETICALLY (By Provider Name)"
  1.  S DIR("A",3)="     2.  By PROVIDER CLASS"
  1.  S DIR("A",4)="     3.  By STAFF CATEGORY"
  1.  S DIR("A")="Select (1, 2, or 3):  ",DIR(0)="NAO^1:3" D ^DIR
  1.  G MEND:$D(DTOUT),MEND:X="",MEND:$D(DUOUT),TYPE:Y=-1 S AQAQTYP=Y
  1.  I AQAQTYP=1 S AQAQSRT="" G MDEV
  1.  ;
  1. MALL ;***> choose one or all classes or categories
  1.  K DIR S DIR(0)="Y"
  1.  S DIR("A")=$S(AQAQTYP=2:"Print for All Classes",1:"Print for All Categories")
  1.  S DIR("B")="NO" D ^DIR I Y=1 S AQAQSRT="" G MDEV ;all wards or serv
  1.  I $D(DIRUT) G MEND ;check for timeout,"^", or null
  1.  ;
  1. MCHOOSE ;***> choose which class or category to print
  1.  I AQAQTYP=2 D  G TYPE:'$D(AQAQSRT) G MDEV
  1.  .K DIR,AQAQSRT S DIR(0)="PO^7:EMQZ" D ^DIR
  1.  .Q:$D(DTOUT)  Q:X=""  Q:$D(DUOUT)  Q:Y=-1
  1.  .S AQAQSRT=$P(Y,U,2)
  1.  E  D  G TYPE:'$D(AQAQSRT)
  1.  .K DIR,AQAQSRT S DIR(0)="9002165,.02" D ^DIR
  1.  .Q:$D(DTOUT)  Q:X=""  Q:$D(DUOUT)  Q:Y=-1
  1.  .S AQAQSRT=Y(0)
  1.  ;
  1. MDEV S %ZIS="NPQ" D ^%ZIS G MEND:POP I '$D(IO("Q")) G MLIC1
  1.  K IO("Q") S ZTRTN="MLIC1^AQAQNQ1",ZTDESC="LICENSES DUE TO EXPIRE"
  1.  F AQAQI="AQAQDUE","AQAQSRT","AQAQTYP","AQAQNUM" S ZTSAVE(AQAQI)=""
  1.  D ^%ZTLOAD D ^%ZISC K ZTSK,AQAQDUE,AQAQSRT,AQAQTYP,AQAQNUM Q
  1.  ;
  1. MLIC1 ;**> set variables then call FileMan print
  1.  S L=0,DIC=9002161.2,FLDS="[AQAQ LICENSE DUE]"
  1.  S DHD="W ?0 D MHDR^AQAQNQ1"
  1.  I AQAQTYP=1 S BY="@PROVIDER",(TO,FR)=""
  1.  I AQAQTYP=2 S BY="@PROVIDER",(TO,FR)=AQAQSRT
  1.  I AQAQTYP=3 S BY="STAFF CATEGORY,@PROVIDER",(TO,FR)=AQAQSRT
  1.  S DIS(0)="S AQAQX=$P(^AQAQML(D0,0),U,2) I AQAQX]"""",(+$G(^VA(200,AQAQX,""I""))=0)!($G(^VA(200,AQAQX,""I""))>DT)" ;IHS/ORDC/LJF PATCH #2
  1.  S IOP=ION,DIS(1)="D LASTMLIC^AQAQDUE I AQAQLAST<AQAQDUE"
  1.  D EN1^DIP
  1.  I '$D(ZTQUEUED) K DIR S DIR(0)="E",DIR("A")="RETURN to continue" D ^DIR W @IOF
  1.  ;
  1.  ;**> eoj
  1. MEND D KILL^AQAQUTIL Q
  1.  ;
  1.  ;
  1. MHDR ;**> SUBRTN for report header
  1.  W !?8,"*****Confidential Medical Staff Data Covered by Privacy Act*****"
  1.  W !,"Medical Licenses DUE TO EXPIRE in the next "_AQAQNUM_" months "
  1.  S %H=$H D YX^%DTC W ?60,$P(Y,":",1,2)
  1.  W !!,"PROVIDER NAME",?27,"STATE",?39,"EXPIRATION DATE"
  1.  W ! S X="",$P(X,"=",80)="" W X,!!
  1.  Q