| 1 | VAQREQ11 ;ALB/JFP - PDX, TIME/OCCURENCE LIMITS;01SEPT93
|
|---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
|
|---|
| 3 | EP ; -- Entry point
|
|---|
| 4 | ; - Called from VAQREQ04
|
|---|
| 5 | ; - Calls help routine VAQREQ09
|
|---|
| 6 | ;
|
|---|
| 7 | DEFAULT ; -- Extracts the default time and occurrence limits for HS segments
|
|---|
| 8 | N PARAMND,TLDEF,OLDEF
|
|---|
| 9 | S PARAMND=$G(^VAT(394.81,1,"LIMITS"))
|
|---|
| 10 | S TLDEF=$P(PARAMND,U,1)
|
|---|
| 11 | S OLDEF=$P(PARAMND,U,2)
|
|---|
| 12 | ; -- Extracts existing limits
|
|---|
| 13 | I $D(^TMP("VAQSEG",$J,DOMAIN,SEGMNU)) D
|
|---|
| 14 | .S PARAMND=$G(^TMP("VAQSEG",$J,DOMAIN,SEGMNU))
|
|---|
| 15 | .S TLDEF=$P(PARAMND,U,3)
|
|---|
| 16 | .S OLDEF=$P(PARAMND,U,4)
|
|---|
| 17 | ;
|
|---|
| 18 | DRIVER ; -- Time and Occurrence
|
|---|
| 19 | K TLIMIT,OLIMIT
|
|---|
| 20 | I $P(HSCOMPND,U,2)=1 D ASKTIME
|
|---|
| 21 | I $P(HSCOMPND,U,3)=1 D ASKOCC
|
|---|
| 22 | K DIRUT
|
|---|
| 23 | QUIT
|
|---|
| 24 | ;
|
|---|
| 25 | ASKTIME ; -- Prompts for time limit
|
|---|
| 26 | ; -- Call to Dir to request time
|
|---|
| 27 | S DIR("A")=" Enter Time Limit: "
|
|---|
| 28 | S DIR("B")=TLDEF
|
|---|
| 29 | S DIR(0)="FAO^1:5^D CHKT1^VAQREQ11"
|
|---|
| 30 | S DIR("?")="^D HLPT1^VAQREQ11"
|
|---|
| 31 | S DIR("??")="^D HLPT2^VAQREQ11"
|
|---|
| 32 | W ! D ^DIR K DIR Q:$D(DIRUT)
|
|---|
| 33 | S TLIMIT=Y
|
|---|
| 34 | QUIT
|
|---|
| 35 | ;
|
|---|
| 36 | ASKOCC ; -- Prompts for occurrence limit
|
|---|
| 37 | ; -- Call to Dir to occurrence time
|
|---|
| 38 | S DIR("A")=" Enter Occurence Limit: "
|
|---|
| 39 | S DIR("B")=OLDEF
|
|---|
| 40 | S DIR(0)="FAO^1:5^D CHKO1^VAQREQ11"
|
|---|
| 41 | S DIR("?")="^D HLPO1^VAQREQ11"
|
|---|
| 42 | S DIR("??")="^D HLPO2^VAQREQ11"
|
|---|
| 43 | D ^DIR K DIR Q:$D(DIRUT)
|
|---|
| 44 | S OLIMIT=Y
|
|---|
| 45 | QUIT
|
|---|
| 46 | ;
|
|---|
| 47 | CHKT1 ;
|
|---|
| 48 | N GMTSFUNC
|
|---|
| 49 | S GMTSFUNC=$O(^DD("FUNC","B","UPPERCASE",0))
|
|---|
| 50 | X ^DD("FUNC",GMTSFUNC,1)
|
|---|
| 51 | K:($L(X)<1)!'((X?1N.N1"D")!(X?1N.N1"M")!(X?1N.N1"Y")) X
|
|---|
| 52 | QUIT
|
|---|
| 53 | ;
|
|---|
| 54 | CHKO1 ;
|
|---|
| 55 | K:+X'=X!(X>99999)!(X<1)!(X?.E1"."1N.N) X
|
|---|
| 56 | QUIT
|
|---|
| 57 | ;
|
|---|
| 58 | HLPO1 ; -- ? Help Message for occurrence
|
|---|
| 59 | N DIWL,DIWR,DIWF
|
|---|
| 60 | S X=$G(^DD(142.01,2,3)),DIWL=6,DIWR=80,DIWF="W"
|
|---|
| 61 | D ^DIWP
|
|---|
| 62 | D ^DIWW
|
|---|
| 63 | QUIT
|
|---|
| 64 | ;
|
|---|
| 65 | HLPT1 ; -- ? Help Message for time
|
|---|
| 66 | N DIWL,DIWR,DIWF
|
|---|
| 67 | S X=$G(^DD(142.01,2,3)),DIWL=6,DIWR=80,DIWF="W"
|
|---|
| 68 | D ^DIWP
|
|---|
| 69 | D ^DIWW
|
|---|
| 70 | QUIT
|
|---|
| 71 | ;
|
|---|
| 72 | HLPO2 ; -- ?? Help Message for occurrence
|
|---|
| 73 | N OCC,DIWL,DIWR,DIWF
|
|---|
| 74 | S OCC=0,DIWL=6,DIWR=80,DIWF="W"
|
|---|
| 75 | F S OCC=$O(^DD(142.01,2,21,OCC)) Q:OCC="" D
|
|---|
| 76 | .S X=$G(^DD(142.01,2,21,OCC,0))
|
|---|
| 77 | .D ^DIWP
|
|---|
| 78 | D ^DIWW
|
|---|
| 79 | QUIT
|
|---|
| 80 | HLPT2 ; -- ?? Help Message for time
|
|---|
| 81 | N OCC,DIWL,DIWR,DIWF
|
|---|
| 82 | S OCC=0,DIWL=6,DIWR=80,DIWF="W"
|
|---|
| 83 | F S OCC=$O(^DD(142.01,3,21,OCC)) Q:OCC="" D
|
|---|
| 84 | .S X=$G(^DD(142.01,3,21,OCC,0))
|
|---|
| 85 | .D ^DIWP
|
|---|
| 86 | D ^DIWW
|
|---|
| 87 | QUIT
|
|---|
| 88 | END ; -- End of code
|
|---|
| 89 | QUIT
|
|---|
