PRCAQUE.m

PRCAQUE ;SF-ISC/YJK-AR LIST,REPORT SUBROUTINE -ASK QUEUEING ;4/24/92  8:53 AM

V ;;4.5;Accounts Receivable;;Mar 20, 1995

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

QUE K PRCAQUE S %=2 W !,PRCA("MESS") D YN^DICN Q:%<0  W " "

 I %=0 W !,"Answer <YES> or <NO>" G QUE

QUE1 K IO("Q") S %ZIS("B")="",%ZIS="M",PRCA("DEV")="" S:%=1 %ZIS="MQ",PRCA("DEV")="Q;",IOP="Q"

 D ^%ZIS Q:POP  S PRCA("DEV")=PRCA("DEV")_ION_";"_IOST_";"_IOM_";"_IOSL,PRCA("IOSAVE")=IO(0)

 ;

CKQUE I $D(PRCA("DEV")) S IOP=PRCA("DEV"),%ZIS="M",%ZIS("B")="" S:PRCA("DEV")["Q;" %ZIS="MQ"

 S PRCAQUE="" Q

ASKDT ;to set the 'sort by date' for the report. called by EN8^PRCAQUE

 S:'$D(PRCA("DATE")) PRCA("DATE")="DATE" S (PRCADT1,PRCADT2,PRCAKDT1,PRCAKDT2)="",%DT="AEP",%DT("A")="START WITH "_PRCA("DATE")_": " D ^%DT I Y<0 Q

 S PRCADT1=+Y S:PRCADT1'>0 PRCADT1=2700101

 S %DT="AEP",%DT("A")="GO TO "_PRCA("DATE")_": " D ^%DT Q:Y<0  S PRCADT2=+Y I PRCADT1>PRCADT2 W *7,"  Dates are not appropriate." G ASKDT

 K %DT S PRCAKDT1=$E(PRCADT1,4,5)_"/"_$E(PRCADT1,6,7)_"/"_$E(PRCADT1,2,3),PRCAKDT2=$E(PRCADT2,4,5)_"/"_$E(PRCADT2,6,7)_"/"_$E(PRCADT2,2,3) Q

D ;CONVERTS FILEMAN INTERNAL DATE TO EXTERNAL FORMAT

 S:Y Y=$S($E(Y,4,5):$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+$E(Y,4,5))_" ",1:"")_$S($E(Y,6,7):+$E(Y,6,7)_",",1:"")_($E(Y,1,3)+1700)_$P("@"_$E(Y_0,9,10)_":"_$E(Y_"000",11,12),"^",Y[".")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCAQUE   1407     printed  Apr 09, 2024@20:52:22                                                                                                                                                                                                     Page 2

PRCAQUE   ;SF-ISC/YJK-AR LIST,REPORT SUBROUTINE -ASK QUEUEING ;4/24/92  8:53 AM

V         ;;4.5;Accounts Receivable;;Mar 20, 1995

 +1       ;;Per VHA Directive 10-93-142, this routine should not be modified.

QUE        KILL PRCAQUE

           SET %=2

           WRITE !,PRCA("MESS")

           DO YN^DICN

           if %<0

               QUIT 

           WRITE " "

 +1        IF %=0

               WRITE !,"Answer <YES> or <NO>"

               GOTO QUE

QUE1       KILL IO("Q")

           SET %ZIS("B")=""

           SET %ZIS="M"

           SET PRCA("DEV")=""

           if %=1

               SET %ZIS="MQ"

               SET PRCA("DEV")="Q;"

               SET IOP="Q"

 +1        DO ^%ZIS

           if POP

               QUIT 

           SET PRCA("DEV")=PRCA("DEV")_ION_";"_IOST_";"_IOM_";"_IOSL

           SET PRCA("IOSAVE")=IO(0)

 +2       ;

CKQUE      IF $DATA(PRCA("DEV"))

               SET IOP=PRCA("DEV")

               SET %ZIS="M"

               SET %ZIS("B")=""

               if PRCA("DEV")["Q;"

                   SET %ZIS="MQ"

 +1        SET PRCAQUE=""

           QUIT 

ASKDT     ;to set the 'sort by date' for the report. called by EN8^PRCAQUE

 +1        if '$DATA(PRCA("DATE"))

               SET PRCA("DATE")="DATE"

           SET (PRCADT1,PRCADT2,PRCAKDT1,PRCAKDT2)=""

           SET %DT="AEP"

           SET %DT("A")="START WITH "_PRCA("DATE")_": "

           DO ^%DT

           IF Y<0

               QUIT 

 +2        SET PRCADT1=+Y

           if PRCADT1'>0

               SET PRCADT1=2700101

 +3        SET %DT="AEP"

           SET %DT("A")="GO TO "_PRCA("DATE")_": "

           DO ^%DT

           if Y<0

               QUIT 

           SET PRCADT2=+Y

           IF PRCADT1>PRCADT2

               WRITE *7,"  Dates are not appropriate."

               GOTO ASKDT

 +4        KILL %DT

           SET PRCAKDT1=$EXTRACT(PRCADT1,4,5)_"/"_$EXTRACT(PRCADT1,6,7)_"/"_$EXTRACT(PRCADT1,2,3)

           SET PRCAKDT2=$EXTRACT(PRCADT2,4,5)_"/"_$EXTRACT(PRCADT2,6,7)_"/"_$EXTRACT(PRCADT2,2,3)

           QUIT 

D         ;CONVERTS FILEMAN INTERNAL DATE TO EXTERNAL FORMAT

 +1        if Y

              SET Y=$SELECT($EXTRACT(Y,4,5):$PIECE("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+$EXTRACT(Y,4,5))_" ",1:"")_$SELECT($EXTRACT(Y,6,7):+$EXTRACT(Y,6,7)_",",1:"")_($EXTRACT(Y,1,3)+1700)_$PIECE("@"_$EXTRACT(Y_0,9,10)_":"_...

               ... $EXTRACT(Y_"000",11,12),"^",Y[".")

 +2        QUIT