AQAQNQ.m

AQAQNQ ;IHS/ANMC/LJF - INQUIRE TO CREDENTIAL ENTRY; [ 12/23/93  12:04 PM ]

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

 ;IHS/ORDC/LJF 4/29/93 PATCH #1: changed print of security keys to NEW

 ;                               PERSON file per Kernel 7

 ;

PROV ;EP;****>  displays data for a given provider

 W @IOF,!!?20,"INQUIRY TO PROVIDER CREDENTIALS",!!

 K DIC S DIC("A")="Select PROVIDER NAME:  ",DIC(0)="AQEMZ",DIC=9002165

 D ^DIC G PEND:Y=-1

 S L=0,DIC=9002165,FLDS="[AQAQINQUIRE]",BY="@NUMBER",(TO,FR)=+Y

 D EN1^DIP

 K DIR S DIR(0)="E",DIR("A")="RETURN to continue" D ^DIR

PEND W @IOF K DIC,DIR,X,Y Q

 ;

 ;

INAC ;EP;****>  displays data for an inactive provider

 W @IOF,!!?20,"VIEW INACTIVE PROVIDER'S RECORD",!!

 S AQAQINAC="" ;variable to override screen on inactive providers

 K DIC S DIC("A")="Select NAME OF INACTIVE PROVIDER:  ",DIC(0)="AQEMZ"

 S DIC("S")="I $D(^DIC(6,Y,""I"")),(^(""I"")'="""")"

 S DIC=9002165 D ^DIC G PEND:Y=-1

 S L=0,DIC=9002165,FLDS="[AQAQINQUIRE]",BY="@NUMBER",(TO,FR)=+Y

 D EN1^DIP

 K DIR S DIR(0)="E" D ^DIR

IEND W @IOF K DIC,DIR,X,Y,AQAQINAC Q

 ;

APPL ;EP;****> prints summary for all pending applications

 W @IOF,!!?20,"PENDING APPOINTMENT APPLICATIONS",!!

 W ?5,"This report will print summaries on each provider whose"

 W !,"original application has not yet been approved.  The summaries"

 W !,"will print in alphabetical order.",!!

 ;

 S %ZIS="NPQ" D ^%ZIS Q:POP  I '$D(IO("Q")) G APPL1

 K IO("Q") S ZTRTN="APPL1^AQAQNQ",ZTDESC="PENDING APPLICATIONS"

 D ^%ZTLOAD K ZTSK D ^%ZISC Q

 ;

APPL1 ;**> set variables then call FileMan print

 S L=0,DIC=9002165,FLDS="[AQAQINQUIRE]",BY="#@NAME",(TO,FR)=""

 S IOP=ION,DIS(0)="I $P(^AQAQC(D0,0),U,4)=""""&($P($G(^AQAQC(D0,""R"",1,0)),U,2)="""")"

 D EN1^DIP

 I '$D(ZTQUEUED) K DIR S DIR(0)="E" D ^DIR

AEND W @IOF K DIC,DIR,X,Y Q

 ;

 ;

KEYS ;EP;****>  displays who has access to Credential system

 W @IOF

 W !!,"This program displays a list of computer users who have access"

 W !,"to this Credential Tracking System.  This tool is designed to"

 W !,"be used to monitor the security of the package.",!!

 ;K DIC S DIC(0)="QEMZ",DIC=19.1,X="AQAQZMENU" D ^DIC G KEND:Y=-1 ;IHS/ORDC/LJF 4/29/93 PATCH #1

 ;S L=0,DIC=19.1,FLDS="[AQAQSECURITY]",BY="@NUMBER",(TO,FR)=+Y ;IHS/ORDC/LJF 4/29/93 PATCH #1

 S L=0,DIC=200,FLDS="[AQAQ ACCESS PRINT]",BY="[AQAQ ACCESS SORT]" ;IHS/ORDC/LJF 4/29/93 PATCH #1

 D EN1^DIP

 K DIR S DIR(0)="E" D ^DIR

KEND W @IOF K DIC,DIR,X,Y Q

 ;

 ;

USER ;EP;****>  prints list of all entries and users who have accessed them

 W @IOF,!!?20,"LISTING OF USER ACCESS TO PROVIDER ENTRIES",!!

 S L=0,DIC=9002165,FLDS="[AQAQUSER]",BY="@NAME",(TO,FR)=""

 D EN1^DIP

 K DIR S DIR(0)="E" D ^DIR

UEND W @IOF K DIC,DIR,X,Y Q

 ;

 ;

NOTCONV ;EP;****>  print data not converted to NEW CREDENTIALS file

 W @IOF,!!?20,"DATA NOT CONVERTED TO NEW CREDENTIALS FILE",!!

 W ?5,"This report will print a list of the data that could not"

 W !?5,"be converted to the NEW CREDENTIALS file.  This data includes"

 W !?5,"medical licensure data plus the date privileges were granted."

 W !!

 ;

 S %ZIS="NPQ" D ^%ZIS Q:POP  I '$D(IO("Q")) G NOTC1

 K IO("Q") S ZTRTN="NOTC1^AQAQNQ",ZTDESC="DATA NOT CONVERTED"

 D ^%ZTLOAD K ZTSK D ^%ZISC Q

 ;

NOTC1 ;**> set variables then call FileMan print

 S L=0,DIC=9002155,FLDS="[AQAQ NOT CONVERTED]",BY="@NAME",(TO,FR)=""

 S IOP=ION D EN1^DIP

 I '$D(ZTQUEUED) K DIR S DIR(0)="E" D ^DIR

NEND W @IOF K DIC,DIR,X,Y Q

 ;

 ;

MLHELP ;EP;***> help on Medical License Verified field

 W !!?5,"The license verification date should be one of the following:"

 W !?10,"(1)  Date of Verification Letter"

 W !?10,"(2)  Date of Printout"

 W !?10,"(3)  Date of Call"

 W !?10,"(4)  Date Copy Received (for re-licensure)"

 W !! Q

 ;

 ;

DLQPRV ;EP;***> print inquiry on delq chart numbers for provider

 W @IOF,!!?20,"MEDICAL RECORDS REVIEW FOR A PROVIDER",!!

 K DIC S DIC("A")="Select PROVIDER NAME:  ",DIC(0)="AQEMZ",DIC=9002165

 D ^DIC G PEND:Y=-1

 S L=0,DIC=9002165,FLDS="[AQAQ MED RECORD REVIEW]"

 S BY="@NUMBER",(TO,FR)=+Y D EN1^DIP

 K DIR S DIR(0)="E" D ^DIR

DEND W @IOF K DIC,DIR,X,Y Q

AQAQNQ    ;IHS/ANMC/LJF - INQUIRE TO CREDENTIAL ENTRY; [ 12/23/93  12:04 PM ]

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

 +2       ;IHS/ORDC/LJF 4/29/93 PATCH #1: changed print of security keys to NEW

 +3       ;                               PERSON file per Kernel 7

 +4       ;

PROV      ;EP;****>  displays data for a given provider

 +1        WRITE @IOF,!!?20,"INQUIRY TO PROVIDER CREDENTIALS",!!

 +2        KILL DIC

           SET DIC("A")="Select PROVIDER NAME:  "

           SET DIC(0)="AQEMZ"

           SET DIC=9002165

 +3        DO ^DIC

           IF Y=-1

               GOTO PEND

 +4        SET L=0

           SET DIC=9002165

           SET FLDS="[AQAQINQUIRE]"

           SET BY="@NUMBER"

           SET (TO,FR)=+Y

 +5        DO EN1^DIP

 +6        KILL DIR

           SET DIR(0)="E"

           SET DIR("A")="RETURN to continue"

           DO ^DIR

PEND       WRITE @IOF

           KILL DIC,DIR,X,Y

           QUIT 

 +1       ;

 +2       ;

INAC      ;EP;****>  displays data for an inactive provider

 +1        WRITE @IOF,!!?20,"VIEW INACTIVE PROVIDER'S RECORD",!!

 +2       ;variable to override screen on inactive providers

           SET AQAQINAC=""

 +3        KILL DIC

           SET DIC("A")="Select NAME OF INACTIVE PROVIDER:  "

           SET DIC(0)="AQEMZ"

 +4        SET DIC("S")="I $D(^DIC(6,Y,""I"")),(^(""I"")'="""")"

 +5        SET DIC=9002165

           DO ^DIC

           IF Y=-1

               GOTO PEND

 +6        SET L=0

           SET DIC=9002165

           SET FLDS="[AQAQINQUIRE]"

           SET BY="@NUMBER"

           SET (TO,FR)=+Y

 +7        DO EN1^DIP

 +8        KILL DIR

           SET DIR(0)="E"

           DO ^DIR

IEND       WRITE @IOF

           KILL DIC,DIR,X,Y,AQAQINAC

           QUIT 

 +1       ;

APPL      ;EP;****> prints summary for all pending applications

 +1        WRITE @IOF,!!?20,"PENDING APPOINTMENT APPLICATIONS",!!

 +2        WRITE ?5,"This report will print summaries on each provider whose"

 +3        WRITE !,"original application has not yet been approved.  The summaries"

 +4        WRITE !,"will print in alphabetical order.",!!

 +5       ;

 +6        SET %ZIS="NPQ"

           DO ^%ZIS

           IF POP

               QUIT 

           IF '$DATA(IO("Q"))

               GOTO APPL1

 +7        KILL IO("Q")

           SET ZTRTN="APPL1^AQAQNQ"

           SET ZTDESC="PENDING APPLICATIONS"

 +8        DO ^%ZTLOAD

           KILL ZTSK

           DO ^%ZISC

           QUIT 

 +9       ;

APPL1     ;**> set variables then call FileMan print

 +1        SET L=0

           SET DIC=9002165

           SET FLDS="[AQAQINQUIRE]"

           SET BY="#@NAME"

           SET (TO,FR)=""

 +2        SET IOP=ION

           SET DIS(0)="I $P(^AQAQC(D0,0),U,4)=""""&($P($G(^AQAQC(D0,""R"",1,0)),U,2)="""")"

 +3        DO EN1^DIP

 +4        IF '$DATA(ZTQUEUED)

               KILL DIR

               SET DIR(0)="E"

               DO ^DIR

AEND       WRITE @IOF

           KILL DIC,DIR,X,Y

           QUIT 

 +1       ;

 +2       ;

KEYS      ;EP;****>  displays who has access to Credential system

 +1        WRITE @IOF

 +2        WRITE !!,"This program displays a list of computer users who have access"

 +3        WRITE !,"to this Credential Tracking System.  This tool is designed to"

 +4        WRITE !,"be used to monitor the security of the package.",!!

 +5       ;K DIC S DIC(0)="QEMZ",DIC=19.1,X="AQAQZMENU" D ^DIC G KEND:Y=-1 ;IHS/ORDC/LJF 4/29/93 PATCH #1

 +6       ;S L=0,DIC=19.1,FLDS="[AQAQSECURITY]",BY="@NUMBER",(TO,FR)=+Y ;IHS/ORDC/LJF 4/29/93 PATCH #1

 +7       ;IHS/ORDC/LJF 4/29/93 PATCH #1

           SET L=0

           SET DIC=200

           SET FLDS="[AQAQ ACCESS PRINT]"

           SET BY="[AQAQ ACCESS SORT]"

 +8        DO EN1^DIP

 +9        KILL DIR

           SET DIR(0)="E"

           DO ^DIR

KEND       WRITE @IOF

           KILL DIC,DIR,X,Y

           QUIT 

 +1       ;

 +2       ;

USER      ;EP;****>  prints list of all entries and users who have accessed them

 +1        WRITE @IOF,!!?20,"LISTING OF USER ACCESS TO PROVIDER ENTRIES",!!

 +2        SET L=0

           SET DIC=9002165

           SET FLDS="[AQAQUSER]"

           SET BY="@NAME"

           SET (TO,FR)=""

 +3        DO EN1^DIP

 +4        KILL DIR

           SET DIR(0)="E"

           DO ^DIR

UEND       WRITE @IOF

           KILL DIC,DIR,X,Y

           QUIT 

 +1       ;

 +2       ;

NOTCONV   ;EP;****>  print data not converted to NEW CREDENTIALS file

 +1        WRITE @IOF,!!?20,"DATA NOT CONVERTED TO NEW CREDENTIALS FILE",!!

 +2        WRITE ?5,"This report will print a list of the data that could not"

 +3        WRITE !?5,"be converted to the NEW CREDENTIALS file.  This data includes"

 +4        WRITE !?5,"medical licensure data plus the date privileges were granted."

 +5        WRITE !!

 +6       ;

 +7        SET %ZIS="NPQ"

           DO ^%ZIS

           IF POP

               QUIT 

           IF '$DATA(IO("Q"))

               GOTO NOTC1

 +8        KILL IO("Q")

           SET ZTRTN="NOTC1^AQAQNQ"

           SET ZTDESC="DATA NOT CONVERTED"

 +9        DO ^%ZTLOAD

           KILL ZTSK

           DO ^%ZISC

           QUIT 

 +10      ;

NOTC1     ;**> set variables then call FileMan print

 +1        SET L=0

           SET DIC=9002155

           SET FLDS="[AQAQ NOT CONVERTED]"

           SET BY="@NAME"

           SET (TO,FR)=""

 +2        SET IOP=ION

           DO EN1^DIP

 +3        IF '$DATA(ZTQUEUED)

               KILL DIR

               SET DIR(0)="E"

               DO ^DIR

NEND       WRITE @IOF

           KILL DIC,DIR,X,Y

           QUIT 

 +1       ;

 +2       ;

MLHELP    ;EP;***> help on Medical License Verified field

 +1        WRITE !!?5,"The license verification date should be one of the following:"

 +2        WRITE !?10,"(1)  Date of Verification Letter"

 +3        WRITE !?10,"(2)  Date of Printout"

 +4        WRITE !?10,"(3)  Date of Call"

 +5        WRITE !?10,"(4)  Date Copy Received (for re-licensure)"

 +6        WRITE !!

           QUIT 

 +7       ;

 +8       ;

DLQPRV    ;EP;***> print inquiry on delq chart numbers for provider

 +1        WRITE @IOF,!!?20,"MEDICAL RECORDS REVIEW FOR A PROVIDER",!!

 +2        KILL DIC

           SET DIC("A")="Select PROVIDER NAME:  "

           SET DIC(0)="AQEMZ"

           SET DIC=9002165

 +3        DO ^DIC

           IF Y=-1

               GOTO PEND

 +4        SET L=0

           SET DIC=9002165

           SET FLDS="[AQAQ MED RECORD REVIEW]"

 +5        SET BY="@NUMBER"

           SET (TO,FR)=+Y

           DO EN1^DIP

 +6        KILL DIR

           SET DIR(0)="E"

           DO ^DIR

DEND       WRITE @IOF

           KILL DIC,DIR,X,Y

           QUIT