APSPDUEN.m

APSPDUEN ; IHS/DSD/ENM - CREATE NEW APSP DUE REVIEW ENTRIES ;  [ 09/03/97   1:30 PM ]

 ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

 ;

 ;--------------------------------------------------------------

START ;

 D ADD ; Create new entry in File

 G:APSPDUEN("QUIT") END

 D EDIT ; Creates DUE STUDY CRITERIA entries in multiple

 D CRITERIA ; Answer questions about Criteria

 G START

END D EOJ ; Clean up variables

 Q

 ;---------------------------------------------------------------

 ;

ADD ;

 S APSPDUEN("QUIT")=0

 S DIC(0)="QEAML",DIC="^APSPDUE(32,",DIADD="",DIC("DR")=".01:.07"

 D ^DIC K DIC,DIADD

 I Y=-1 S APSPDUEN("QUIT")=1 G ADDX

 S APSPDUEN("CN")=$P(^APSPDUE(32,+Y,0),U,2)

ADDX ;

 Q

 ;

EDIT S DIE="^APSPDUE(32,",APSPDUEN("STOP")=0,APSPDUEN("X")=0,APSPDUEN("DA")=APSPDUEN("CN") F  S APSPDUEN("X")=$O(^APSPDUE(32.1,APSPDUEN("DA"),11,APSPDUEN("X"))) Q:APSPDUEN("X")'=+APSPDUEN("X")!(APSPDUEN("STOP"))  D

 . S DR="1100///`"_APSPDUEN("X")

 . S DR(2,9009032.011)=".02////"

 . D ^DIE I $D(Y) S APSPDUEN("STOP")=1

 Q

CRITERIA ;

 S APSPDUEN("STOP")=0,APSPDUEN("X")=0,APSPDUEN("DA")=DA,DIC(0)="ENF",(DIC,DIE)="^APSPDUE(32,APSPDUEN(""DA""),11," F  S APSPDUEN("X")=$O(^APSPDUE(32,APSPDUEN("DA"),11,APSPDUEN("X"))) Q:APSPDUEN("X")'=+APSPDUEN("X")!(APSPDUEN("STOP"))  W ! D

 . S X=APSPDUEN("X")

 . F APSPWP=0:0 S APSPWP=$O(^APSPDUE(32.2,X,11,APSPWP)) Q:APSPWP'=+APSPWP  W !,^APSPDUE(32.2,X,11,APSPWP,0)

 . S DR=".02",DA(1)=1,DA=APSPDUEN("X") D ^DIE I $D(Y) S APSPDUEN("STOP")=1

 S DA=APSPDUEN("DA"),DIE="^APSPDUE(32,",DR=".08;1200" D ^DIE

 Q

EOJ ;

 K APSPDUEN,DIE,DIC,DR,X,Y,DA,D0,APSPWP

 Q

APSPDUEN  ; IHS/DSD/ENM - CREATE NEW APSP DUE REVIEW ENTRIES ;  [ 09/03/97   1:30 PM ]

 +1       ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

 +2       ;

 +3       ;--------------------------------------------------------------

START     ;

 +1       ; Create new entry in File

           DO ADD

 +2        IF APSPDUEN("QUIT")

               GOTO END

 +3       ; Creates DUE STUDY CRITERIA entries in multiple

           DO EDIT

 +4       ; Answer questions about Criteria

           DO CRITERIA

 +5        GOTO START

END       ; Clean up variables

           DO EOJ

 +1        QUIT 

 +2       ;---------------------------------------------------------------

 +3       ;

ADD       ;

 +1        SET APSPDUEN("QUIT")=0

 +2        SET DIC(0)="QEAML"

           SET DIC="^APSPDUE(32,"

           SET DIADD=""

           SET DIC("DR")=".01:.07"

 +3        DO ^DIC

           KILL DIC,DIADD

 +4        IF Y=-1

               SET APSPDUEN("QUIT")=1

               GOTO ADDX

 +5        SET APSPDUEN("CN")=$PIECE(^APSPDUE(32,+Y,0),U,2)

ADDX      ;

 +1        QUIT 

 +2       ;

EDIT       SET DIE="^APSPDUE(32,"

           SET APSPDUEN("STOP")=0

           SET APSPDUEN("X")=0

           SET APSPDUEN("DA")=APSPDUEN("CN")

           FOR 

               SET APSPDUEN("X")=$ORDER(^APSPDUE(32.1,APSPDUEN("DA"),11,APSPDUEN("X")))

               IF APSPDUEN("X")'=+APSPDUEN("X")!(APSPDUEN("STOP"))

                   QUIT 

               Begin DoDot:1

 +1                SET DR="1100///`"_APSPDUEN("X")

 +2                SET DR(2,9009032.011)=".02////"

 +3                DO ^DIE

                   IF $DATA(Y)

                       SET APSPDUEN("STOP")=1

               End DoDot:1

 +4        QUIT 

CRITERIA  ;

 +1        SET APSPDUEN("STOP")=0

           SET APSPDUEN("X")=0

           SET APSPDUEN("DA")=DA

           SET DIC(0)="ENF"

           SET (DIC,DIE)="^APSPDUE(32,APSPDUEN(""DA""),11,"

           FOR 

               SET APSPDUEN("X")=$ORDER(^APSPDUE(32,APSPDUEN("DA"),11,APSPDUEN("X")))

               IF APSPDUEN("X")'=+APSPDUEN("X")!(APSPDUEN("STOP"))

                   QUIT 

               WRITE !

               Begin DoDot:1

 +2                SET X=APSPDUEN("X")

 +3                FOR APSPWP=0:0

                       SET APSPWP=$ORDER(^APSPDUE(32.2,X,11,APSPWP))

                       IF APSPWP'=+APSPWP

                           QUIT 

                       WRITE !,^APSPDUE(32.2,X,11,APSPWP,0)

 +4                SET DR=".02"

                   SET DA(1)=1

                   SET DA=APSPDUEN("X")

                   DO ^DIE

                   IF $DATA(Y)

                       SET APSPDUEN("STOP")=1

               End DoDot:1

 +5        SET DA=APSPDUEN("DA")

           SET DIE="^APSPDUE(32,"

           SET DR=".08;1200"

           DO ^DIE

 +6        QUIT 

EOJ       ;

 +1        KILL APSPDUEN,DIE,DIC,DR,X,Y,DA,D0,APSPWP

 +2        QUIT