APSQFAS1.m

APSQFAS1 ;IHS/ASDS/ENM/POC - QUESTIONS FOR NEW RX ORDER ENTRY  

 ;;6.0;IHS PHARMACY MODIFICATIONS;**3**;FEB 20, 2001

START ;EP

 S (PSONEW("DFLG"),PSONEW("FIELD"),PSONEW1)=0

 ;

2 S PSONEW("FLD")=2 D PTSTAT^PSODIR1(.PSONEW) ; Get Patient Status

 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")

 ;

 ;

9 S PSONEW("FLD")=9 D PROV^PSODIR(.PSONEW) ; Get Provider

 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")

 ;

10 I $G(DUZ("AG"))="I" S PSONEW("FLD")=10 D EXP^PSODIR2(.PSONEW) ; Get Expiration Date - Indian Health Service ONLY

 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")

 ;

11 S PSONEW("FLD")=11 D CLINIC^PSODIR2(.PSONEW) ; Get Clinic

 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")

 ;

12 S PSONEW("FLD")=12 D MW^PSODIR2(.PSONEW) ; Get Mail/Window Info

 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")

 ;

14 S PSONEW("FLD")=14 D ISSDT^PSODIR2(.PSONEW) ; Get Issue Date

 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")

 ;

 ;IHS/DSD/ENM 10/05/94 FILL DATE EDIT DISABLED PSG REQ

15 ;S PSONEW("FLD")=15 D FILLDT^PSODIR2(.PSONEW) ; Get Fill date

 ;G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")

 S (PSONEW("FILL DATE"),APSPRFD)=PSONEW("ISSUE DATE") ;/DSD/ENM 4/7/94

 ;

16 S PSONEW("FLD")=16 D CLERK^PSODIR2(.PSONEW) ; Get Clerk Code

 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")

 ;

 S:$G(PSOBILRX)'=1 PSONEW("BST")=PSOBILST G:$G(PSOBILRX)'=1 END ;SHOW DEPENDING ON VAR PSOBILRX IHS/OKCAO/POC 8/18/2000

200 S PSONEW("FLD")=200 D BST^PSODIR1(.PSONEW) ;GET BILLING STATUS CODE

 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")

 ;

 M APSQSAVE=PSONEW ;TO SAVE FOR OVER AND OVER ON APSQFAS3

END ;

 K PSONEW1

 Q

 ;

JUMP ;

 ;IHS/DSD/ENM 10/05/94 9999999.02:09=CHRONIC MED FIELD ADDED TO NEXT LINE

 ;S PSONEW("FIELD")=$S(+Y=.01:1,+Y=3:2,+Y=6:3,+Y=10:4,+Y=7:5,+Y=10.6:6,+Y=8:7,+Y=9:8,+Y=4:9,+Y=29:10,+Y=5:11,+Y=11:12,+Y=12:13,+Y=1:14,+Y=22:15,+Y=16:16,+Y=9999999.02:"09",1:PSONEW("FLD"))

 S PSONEW("FIELD")=$S(+Y=3:2,+Y=4:9,+Y=29:10,+Y=5:11,+Y=11:12,+Y=1:14,+Y=22:15,+Y=16:16,+Y=9999999.07:200,1:PSONEW("FLD")) ;IHS/OKCAO/POC 8/18/2000

 I PSONEW("FIELD")>PSONEW("FLD") W !,*7,"Cannot jump ahead ..",! S PSONEW("FIELD")=PSONEW("FLD")

 Q

APSQFAS1  ;IHS/ASDS/ENM/POC - QUESTIONS FOR NEW RX ORDER ENTRY  

 +1       ;;6.0;IHS PHARMACY MODIFICATIONS;**3**;FEB 20, 2001

START     ;EP

 +1        SET (PSONEW("DFLG"),PSONEW("FIELD"),PSONEW1)=0

 +2       ;

2         ; Get Patient Status

           SET PSONEW("FLD")=2

           DO PTSTAT^PSODIR1(.PSONEW)

 +1        IF PSONEW("DFLG")

               GOTO END

           IF PSONEW("FIELD")

               GOTO @PSONEW("FIELD")

 +2       ;

 +3       ;

9         ; Get Provider

           SET PSONEW("FLD")=9

           DO PROV^PSODIR(.PSONEW)

 +1        IF PSONEW("DFLG")

               GOTO END

           IF PSONEW("FIELD")

               GOTO @PSONEW("FIELD")

 +2       ;

10        ; Get Expiration Date - Indian Health Service ONLY

           IF $GET(DUZ("AG"))="I"

               SET PSONEW("FLD")=10

               DO EXP^PSODIR2(.PSONEW)

 +1        IF PSONEW("DFLG")

               GOTO END

           IF PSONEW("FIELD")

               GOTO @PSONEW("FIELD")

 +2       ;

11        ; Get Clinic

           SET PSONEW("FLD")=11

           DO CLINIC^PSODIR2(.PSONEW)

 +1        IF PSONEW("DFLG")

               GOTO END

           IF PSONEW("FIELD")

               GOTO @PSONEW("FIELD")

 +2       ;

12        ; Get Mail/Window Info

           SET PSONEW("FLD")=12

           DO MW^PSODIR2(.PSONEW)

 +1        IF PSONEW("DFLG")

               GOTO END

           IF PSONEW("FIELD")

               GOTO @PSONEW("FIELD")

 +2       ;

14        ; Get Issue Date

           SET PSONEW("FLD")=14

           DO ISSDT^PSODIR2(.PSONEW)

 +1        IF PSONEW("DFLG")

               GOTO END

           IF PSONEW("FIELD")

               GOTO @PSONEW("FIELD")

 +2       ;

 +3       ;IHS/DSD/ENM 10/05/94 FILL DATE EDIT DISABLED PSG REQ

15        ;S PSONEW("FLD")=15 D FILLDT^PSODIR2(.PSONEW) ; Get Fill date

 +1       ;G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")

 +2       ;/DSD/ENM 4/7/94

           SET (PSONEW("FILL DATE"),APSPRFD)=PSONEW("ISSUE DATE")

 +3       ;

16        ; Get Clerk Code

           SET PSONEW("FLD")=16

           DO CLERK^PSODIR2(.PSONEW)

 +1        IF PSONEW("DFLG")

               GOTO END

           IF PSONEW("FIELD")

               GOTO @PSONEW("FIELD")

 +2       ;

 +3       ;SHOW DEPENDING ON VAR PSOBILRX IHS/OKCAO/POC 8/18/2000

           IF $GET(PSOBILRX)'=1

               SET PSONEW("BST")=PSOBILST

           IF $GET(PSOBILRX)'=1

               GOTO END

200       ;GET BILLING STATUS CODE

           SET PSONEW("FLD")=200

           DO BST^PSODIR1(.PSONEW)

 +1        IF PSONEW("DFLG")

               GOTO END

           IF PSONEW("FIELD")

               GOTO @PSONEW("FIELD")

 +2       ;

 +3       ;TO SAVE FOR OVER AND OVER ON APSQFAS3

           MERGE APSQSAVE=PSONEW

END       ;

 +1        KILL PSONEW1

 +2        QUIT 

 +3       ;

JUMP      ;

 +1       ;IHS/DSD/ENM 10/05/94 9999999.02:09=CHRONIC MED FIELD ADDED TO NEXT LINE

 +2       ;S PSONEW("FIELD")=$S(+Y=.01:1,+Y=3:2,+Y=6:3,+Y=10:4,+Y=7:5,+Y=10.6:6,+Y=8:7,+Y=9:8,+Y=4:9,+Y=29:10,+Y=5:11,+Y=11:12,+Y=12:13,+Y=1:14,+Y=22:15,+Y=16:16,+Y=9999999.02:"09",1:PSONEW("FLD"))

 +3       ;IHS/OKCAO/POC 8/18/2000

           SET PSONEW("FIELD")=$SELECT(+Y=3:2,+Y=4:9,+Y=29:10,+Y=5:11,+Y=11:12,+Y=1:14,+Y=22:15,+Y=16:16,+Y=9999999.07:200,1:PSONEW("FLD"))

 +4        IF PSONEW("FIELD")>PSONEW("FLD")

               WRITE !,*7,"Cannot jump ahead ..",!

               SET PSONEW("FIELD")=PSONEW("FLD")

 +5        QUIT