ABSPOS6J.m

ABSPOS6J ; IHS/FCS/DRS - user screen subrous ; 

 ;;1.0;PHARMACY POINT OF SALE;**49**;JUN 21, 2001;Build 38

 Q

HEADER ; protocol ABSP P1 HEADER ; edit header  (EV  "Edit view screen")

 ; first, ask "All users or just one user or one patient?"

 D FULL^VALM1

 N WHO,TIMEWIN,PAT,PATTIME,UPDFREQ,DIC,DA,Y,X,DTOUT,DUOUT

 W !

HDR1 S X=$$SET^ABSPOSU3("Display for  1:One user  or  2:All users  or  3:One patient? ","1",0,"H","1:One user;2:All users;3:One patient")

 W !

 I X<1 G HDR8A

 ; Note: one user / one patient combination is not implemented 

 ;  If you choose one patient, you get them all, regardless of user,

 ;  and the time window for weeding out old ones does not apply.

 I X=2 S WHO=0 G HDR3

 I X=3 S WHO=0 G HDRA ; and later come back to HDR88 or HDR8A

HDR2 ; just one user - which one?

 S DIC=200,DIC(0)="AEMNQZ",DIC("A")="Select POS user: "

 S DIC("B")=$P(^VA(200,DUZ,0),U)

 ;S DIC("S")=screening, with Y=IEN, ^VA(200,Y,0) in naked

 D ^DIC W ! G HDR8A:$G(DUOUT)!$G(DTOUT),HDR1:Y<1 S WHO=+Y

HDR3 ; time frame to keep patient on screen

 W !,"Enter the number of MINUTES, the length of time that",!

 W "completed transactions will be retained on the screen.",!

 S X=^TMP("ABSPOS",$J,"TIME"),X=$P(X,".",2),X=X_"000000" ; hhmmss0000

 S Y=$E(X,1,2)*60+$E(X,3,4)

 S X=$$FREETEXT^ABSPOSU2("Retention time:  ",Y,1,1,6) W !

 I X<1 G HDR8A

 I X'?1N.N!(X>1439) W " ??" G HDR3

 S TIMEWIN="."_$TR($J(X\60,2)," ","0")_$TR($J(X#60,2)," ","0")

HDR4 ; Frequency of updates in continuous update mode

 ; HDRA rejoins here

 S X=5 ; minimum allowed value for frequency

 W !,"Enter the number of SECONDS between updates when the display",!

 W "is in CONTINUOUS UPDATE MODE.",!

 S X=$$NUMERIC^ABSPOSU2("Seconds between updates: ",^TMP("ABSPOS",$J,"FREQ"),0,X,9999,0) W !

 I X'?1N.N G HDR8A

 S UPDFREQ=X

HDR8 S ^TMP("ABSPOS",$J,"USER")=WHO

 I TIMEWIN'=^("TIME") S ^("TIME")=TIMEWIN,^("LAST UPDATE")=""

 S ^TMP("ABSPOS",$J,"FREQ")=UPDFREQ

 S ^TMP("ABSPOS",$J,"PATIENT")=0

HDR88 W !,"Settings have been changed.",!

 ; at this point, shouldn't we wipe everything off and rebuild?

 N NODISPLY S NODISPLY=1 D UPD^ABSPOS6A

 G HDR9

HDR8A W !,"No settings have been changed.",!

HDR9 W "Done",! H 2

 S VALMBCK="R"

 Q

HDRA ; display for which one patient?

 ; *ABSP*1.0T7*7* :

 ;    Want to do the lookup with DUZ(2)=0 so as to be able to

 ;    access all point of sale patients regardless of division.

 ;    SAC 2.3.1.4.1 says this is okay so long as we reset DUZ(2)

 ;    to its original value.

 N ABSPDUZ2,BBLIMIT S ABSPDUZ2=+$G(DUZ(2)),DUZ(2)=0 ; ABSP*1.0T7*7

 S DIC=2,DIC(0)="AEMQZ",DIC("A")="Prescriptions for which patient? "

 S DIC("S")="I $D(^ABSPT(""AC"",Y))"

 D ^DIC W !

 S DUZ(2)=ABSPDUZ2 ; Restore original DUZ(2) ; ABSP*1.0T7*7

 G HDR9:$G(DUOUT)!$G(DTOUT),HDRA:(Y<1)  S PAT=+Y

 W !,"Enter the number of DAYS to go back to find"

 W !,"Point of Sale activity for ",$P(Y(0),U),"."

 W ! S X=^TMP("ABSPOS",$J,"PATIENT TIME")

 ; /IHS/OIT/RAM ; 16 OCT 2017 ; CR#09828 Changes the amount of time we can back-bill payers; change

 ;     1 year limit to a new field in the ABSP SETUP file with that parameter. Default is now 6 years.

 ; S BBLIMIT=$D(^ABSP(9002313.99,"BACKLIMIT")) ; Grab default from ABSP SETUP file.

 ; I BBLIMIT=0 S BBLIMIT=2192 ; If there is no value, set it to 6 years (in days).

 S BBLIMIT=365 ; 31 OCT 17 ; CR 9828 IS NOW ON HOLD; CHANGE BACK TO ORIGINAL 1 YEAR BEHAVIOUR.

 S X=$$NUMERIC^ABSPOSU2("Number of days:  ",X,1,1,BBLIMIT) W !

 ; ; S X=$$NUMERIC^ABSPOSU2("Number of days:  ",X,1,1,365) W !

 ; /IHS/OIT/RAM ; 16 OCT 2017 ; END OF CHANGES FOR CR#09828

 I X<1 G HDRA

 S PATTIME=X

 S ^TMP("ABSPOS",$J,"PATIENT")=PAT,^("PATIENT TIME")=PATTIME

 S ^TMP("ABSPOS",$J,"USER")=0

 G HDR88

ABSPOS6J  ; IHS/FCS/DRS - user screen subrous ; 

 +1       ;;1.0;PHARMACY POINT OF SALE;**49**;JUN 21, 2001;Build 38

 +2        QUIT 

HEADER    ; protocol ABSP P1 HEADER ; edit header  (EV  "Edit view screen")

 +1       ; first, ask "All users or just one user or one patient?"

 +2        DO FULL^VALM1

 +3        NEW WHO,TIMEWIN,PAT,PATTIME,UPDFREQ,DIC,DA,Y,X,DTOUT,DUOUT

 +4        WRITE !

HDR1       SET X=$$SET^ABSPOSU3("Display for  1:One user  or  2:All users  or  3:One patient? ","1",0,"H","1:One user;2:All users;3:One patient")

 +1        WRITE !

 +2        IF X<1

               GOTO HDR8A

 +3       ; Note: one user / one patient combination is not implemented 

 +4       ;  If you choose one patient, you get them all, regardless of user,

 +5       ;  and the time window for weeding out old ones does not apply.

 +6        IF X=2

               SET WHO=0

               GOTO HDR3

 +7       ; and later come back to HDR88 or HDR8A

           IF X=3

               SET WHO=0

               GOTO HDRA

HDR2      ; just one user - which one?

 +1        SET DIC=200

           SET DIC(0)="AEMNQZ"

           SET DIC("A")="Select POS user: "

 +2        SET DIC("B")=$PIECE(^VA(200,DUZ,0),U)

 +3       ;S DIC("S")=screening, with Y=IEN, ^VA(200,Y,0) in naked

 +4        DO ^DIC

           WRITE !

           IF $GET(DUOUT)!$GET(DTOUT)

               GOTO HDR8A

           IF Y<1

               GOTO HDR1

           SET WHO=+Y

HDR3      ; time frame to keep patient on screen

 +1        WRITE !,"Enter the number of MINUTES, the length of time that",!

 +2        WRITE "completed transactions will be retained on the screen.",!

 +3       ; hhmmss0000

           SET X=^TMP("ABSPOS",$JOB,"TIME")

           SET X=$PIECE(X,".",2)

           SET X=X_"000000"

 +4        SET Y=$EXTRACT(X,1,2)*60+$EXTRACT(X,3,4)

 +5        SET X=$$FREETEXT^ABSPOSU2("Retention time:  ",Y,1,1,6)

           WRITE !

 +6        IF X<1

               GOTO HDR8A

 +7        IF X'?1N.N!(X>1439)

               WRITE " ??"

               GOTO HDR3

 +8        SET TIMEWIN="."_$TRANSLATE($JUSTIFY(X\60,2)," ","0")_$TRANSLATE($JUSTIFY(X#60,2)," ","0")

HDR4      ; Frequency of updates in continuous update mode

 +1       ; HDRA rejoins here

 +2       ; minimum allowed value for frequency

           SET X=5

 +3        WRITE !,"Enter the number of SECONDS between updates when the display",!

 +4        WRITE "is in CONTINUOUS UPDATE MODE.",!

 +5        SET X=$$NUMERIC^ABSPOSU2("Seconds between updates: ",^TMP("ABSPOS",$JOB,"FREQ"),0,X,9999,0)

           WRITE !

 +6        IF X'?1N.N

               GOTO HDR8A

 +7        SET UPDFREQ=X

HDR8       SET ^TMP("ABSPOS",$JOB,"USER")=WHO

 +1        IF TIMEWIN'=^("TIME")

               SET ^("TIME")=TIMEWIN

               SET ^("LAST UPDATE")=""

 +2        SET ^TMP("ABSPOS",$JOB,"FREQ")=UPDFREQ

 +3        SET ^TMP("ABSPOS",$JOB,"PATIENT")=0

HDR88      WRITE !,"Settings have been changed.",!

 +1       ; at this point, shouldn't we wipe everything off and rebuild?

 +2        NEW NODISPLY

           SET NODISPLY=1

           DO UPD^ABSPOS6A

 +3        GOTO HDR9

HDR8A      WRITE !,"No settings have been changed.",!

HDR9       WRITE "Done",!

           HANG 2

 +1        SET VALMBCK="R"

 +2        QUIT 

HDRA      ; display for which one patient?

 +1       ; *ABSP*1.0T7*7* :

 +2       ;    Want to do the lookup with DUZ(2)=0 so as to be able to

 +3       ;    access all point of sale patients regardless of division.

 +4       ;    SAC 2.3.1.4.1 says this is okay so long as we reset DUZ(2)

 +5       ;    to its original value.

 +6       ; ABSP*1.0T7*7

           NEW ABSPDUZ2,BBLIMIT

           SET ABSPDUZ2=+$GET(DUZ(2))

           SET DUZ(2)=0

 +7        SET DIC=2

           SET DIC(0)="AEMQZ"

           SET DIC("A")="Prescriptions for which patient? "

 +8        SET DIC("S")="I $D(^ABSPT(""AC"",Y))"

 +9        DO ^DIC

           WRITE !

 +10      ; Restore original DUZ(2) ; ABSP*1.0T7*7

           SET DUZ(2)=ABSPDUZ2

 +11       IF $GET(DUOUT)!$GET(DTOUT)

               GOTO HDR9

           IF (Y<1)

               GOTO HDRA

           SET PAT=+Y

 +12       WRITE !,"Enter the number of DAYS to go back to find"

 +13       WRITE !,"Point of Sale activity for ",$PIECE(Y(0),U),"."

 +14       WRITE !

           SET X=^TMP("ABSPOS",$JOB,"PATIENT TIME")

 +15      ; /IHS/OIT/RAM ; 16 OCT 2017 ; CR#09828 Changes the amount of time we can back-bill payers; change

 +16      ;     1 year limit to a new field in the ABSP SETUP file with that parameter. Default is now 6 years.

 +17      ; S BBLIMIT=$D(^ABSP(9002313.99,"BACKLIMIT")) ; Grab default from ABSP SETUP file.

 +18      ; I BBLIMIT=0 S BBLIMIT=2192 ; If there is no value, set it to 6 years (in days).

 +19      ; 31 OCT 17 ; CR 9828 IS NOW ON HOLD; CHANGE BACK TO ORIGINAL 1 YEAR BEHAVIOUR.

           SET BBLIMIT=365

 +20       SET X=$$NUMERIC^ABSPOSU2("Number of days:  ",X,1,1,BBLIMIT)

           WRITE !

 +21      ; ; S X=$$NUMERIC^ABSPOSU2("Number of days:  ",X,1,1,365) W !

 +22      ; /IHS/OIT/RAM ; 16 OCT 2017 ; END OF CHANGES FOR CR#09828

 +23       IF X<1

               GOTO HDRA

 +24       SET PATTIME=X

 +25       SET ^TMP("ABSPOS",$JOB,"PATIENT")=PAT

           SET ^("PATIENT TIME")=PATTIME

 +26       SET ^TMP("ABSPOS",$JOB,"USER")=0

 +27       GOTO HDR88