VAQREQ11 ;ALB/JFP - PDX, TIME/OCCURENCE LIMITS;01SEPT93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
EP ; -- Entry point
; - Called from VAQREQ04
; - Calls help routine VAQREQ09
;
DEFAULT ; -- Extracts the default time and occurrence limits for HS segments
N PARAMND,TLDEF,OLDEF
S PARAMND=$G(^VAT(394.81,1,"LIMITS"))
S TLDEF=$P(PARAMND,U,1)
S OLDEF=$P(PARAMND,U,2)
; -- Extracts existing limits
I $D(^TMP("VAQSEG",$J,DOMAIN,SEGMNU)) D
.S PARAMND=$G(^TMP("VAQSEG",$J,DOMAIN,SEGMNU))
.S TLDEF=$P(PARAMND,U,3)
.S OLDEF=$P(PARAMND,U,4)
;
DRIVER ; -- Time and Occurrence
K TLIMIT,OLIMIT
I $P(HSCOMPND,U,2)=1 D ASKTIME
I $P(HSCOMPND,U,3)=1 D ASKOCC
K DIRUT
QUIT
;
ASKTIME ; -- Prompts for time limit
; -- Call to Dir to request time
S DIR("A")=" Enter Time Limit: "
S DIR("B")=TLDEF
S DIR(0)="FAO^1:5^D CHKT1^VAQREQ11"
S DIR("?")="^D HLPT1^VAQREQ11"
S DIR("??")="^D HLPT2^VAQREQ11"
W ! D ^DIR K DIR Q:$D(DIRUT)
S TLIMIT=Y
QUIT
;
ASKOCC ; -- Prompts for occurrence limit
; -- Call to Dir to occurrence time
S DIR("A")=" Enter Occurence Limit: "
S DIR("B")=OLDEF
S DIR(0)="FAO^1:5^D CHKO1^VAQREQ11"
S DIR("?")="^D HLPO1^VAQREQ11"
S DIR("??")="^D HLPO2^VAQREQ11"
D ^DIR K DIR Q:$D(DIRUT)
S OLIMIT=Y
QUIT
;
CHKT1 ;
N GMTSFUNC
S GMTSFUNC=$O(^DD("FUNC","B","UPPERCASE",0))
X ^DD("FUNC",GMTSFUNC,1)
K:($L(X)<1)!'((X?1N.N1"D")!(X?1N.N1"M")!(X?1N.N1"Y")) X
QUIT
;
CHKO1 ;
K:+X'=X!(X>99999)!(X<1)!(X?.E1"."1N.N) X
QUIT
;
HLPO1 ; -- ? Help Message for occurrence
N DIWL,DIWR,DIWF
S X=$G(^DD(142.01,2,3)),DIWL=6,DIWR=80,DIWF="W"
D ^DIWP
D ^DIWW
QUIT
;
HLPT1 ; -- ? Help Message for time
N DIWL,DIWR,DIWF
S X=$G(^DD(142.01,2,3)),DIWL=6,DIWR=80,DIWF="W"
D ^DIWP
D ^DIWW
QUIT
;
HLPO2 ; -- ?? Help Message for occurrence
N OCC,DIWL,DIWR,DIWF
S OCC=0,DIWL=6,DIWR=80,DIWF="W"
F S OCC=$O(^DD(142.01,2,21,OCC)) Q:OCC="" D
.S X=$G(^DD(142.01,2,21,OCC,0))
.D ^DIWP
D ^DIWW
QUIT
HLPT2 ; -- ?? Help Message for time
N OCC,DIWL,DIWR,DIWF
S OCC=0,DIWL=6,DIWR=80,DIWF="W"
F S OCC=$O(^DD(142.01,3,21,OCC)) Q:OCC="" D
.S X=$G(^DD(142.01,3,21,OCC,0))
.D ^DIWP
D ^DIWW
QUIT
END ; -- End of code
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQREQ11 2243 printed Nov 22, 2024@17:36:53 Page 2
VAQREQ11 ;ALB/JFP - PDX, TIME/OCCURENCE LIMITS;01SEPT93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
EP ; -- Entry point
+1 ; - Called from VAQREQ04
+2 ; - Calls help routine VAQREQ09
+3 ;
DEFAULT ; -- Extracts the default time and occurrence limits for HS segments
+1 NEW PARAMND,TLDEF,OLDEF
+2 SET PARAMND=$GET(^VAT(394.81,1,"LIMITS"))
+3 SET TLDEF=$PIECE(PARAMND,U,1)
+4 SET OLDEF=$PIECE(PARAMND,U,2)
+5 ; -- Extracts existing limits
+6 IF $DATA(^TMP("VAQSEG",$JOB,DOMAIN,SEGMNU))
Begin DoDot:1
+7 SET PARAMND=$GET(^TMP("VAQSEG",$JOB,DOMAIN,SEGMNU))
+8 SET TLDEF=$PIECE(PARAMND,U,3)
+9 SET OLDEF=$PIECE(PARAMND,U,4)
End DoDot:1
+10 ;
DRIVER ; -- Time and Occurrence
+1 KILL TLIMIT,OLIMIT
+2 IF $PIECE(HSCOMPND,U,2)=1
DO ASKTIME
+3 IF $PIECE(HSCOMPND,U,3)=1
DO ASKOCC
+4 KILL DIRUT
+5 QUIT
+6 ;
ASKTIME ; -- Prompts for time limit
+1 ; -- Call to Dir to request time
+2 SET DIR("A")=" Enter Time Limit: "
+3 SET DIR("B")=TLDEF
+4 SET DIR(0)="FAO^1:5^D CHKT1^VAQREQ11"
+5 SET DIR("?")="^D HLPT1^VAQREQ11"
+6 SET DIR("??")="^D HLPT2^VAQREQ11"
+7 WRITE !
DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+8 SET TLIMIT=Y
+9 QUIT
+10 ;
ASKOCC ; -- Prompts for occurrence limit
+1 ; -- Call to Dir to occurrence time
+2 SET DIR("A")=" Enter Occurence Limit: "
+3 SET DIR("B")=OLDEF
+4 SET DIR(0)="FAO^1:5^D CHKO1^VAQREQ11"
+5 SET DIR("?")="^D HLPO1^VAQREQ11"
+6 SET DIR("??")="^D HLPO2^VAQREQ11"
+7 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+8 SET OLIMIT=Y
+9 QUIT
+10 ;
CHKT1 ;
+1 NEW GMTSFUNC
+2 SET GMTSFUNC=$ORDER(^DD("FUNC","B","UPPERCASE",0))
+3 XECUTE ^DD("FUNC",GMTSFUNC,1)
+4 if ($LENGTH(X)<1)!'((X?1N.N1"D")!(X?1N.N1"M")!(X?1N.N1"Y"))
KILL X
+5 QUIT
+6 ;
CHKO1 ;
+1 if +X'=X!(X>99999)!(X<1)!(X?.E1"."1N.N)
KILL X
+2 QUIT
+3 ;
HLPO1 ; -- ? Help Message for occurrence
+1 NEW DIWL,DIWR,DIWF
+2 SET X=$GET(^DD(142.01,2,3))
SET DIWL=6
SET DIWR=80
SET DIWF="W"
+3 DO ^DIWP
+4 DO ^DIWW
+5 QUIT
+6 ;
HLPT1 ; -- ? Help Message for time
+1 NEW DIWL,DIWR,DIWF
+2 SET X=$GET(^DD(142.01,2,3))
SET DIWL=6
SET DIWR=80
SET DIWF="W"
+3 DO ^DIWP
+4 DO ^DIWW
+5 QUIT
+6 ;
HLPO2 ; -- ?? Help Message for occurrence
+1 NEW OCC,DIWL,DIWR,DIWF
+2 SET OCC=0
SET DIWL=6
SET DIWR=80
SET DIWF="W"
+3 FOR
SET OCC=$ORDER(^DD(142.01,2,21,OCC))
if OCC=""
QUIT
Begin DoDot:1
+4 SET X=$GET(^DD(142.01,2,21,OCC,0))
+5 DO ^DIWP
End DoDot:1
+6 DO ^DIWW
+7 QUIT
HLPT2 ; -- ?? Help Message for time
+1 NEW OCC,DIWL,DIWR,DIWF
+2 SET OCC=0
SET DIWL=6
SET DIWR=80
SET DIWF="W"
+3 FOR
SET OCC=$ORDER(^DD(142.01,3,21,OCC))
if OCC=""
QUIT
Begin DoDot:1
+4 SET X=$GET(^DD(142.01,3,21,OCC,0))
+5 DO ^DIWP
End DoDot:1
+6 DO ^DIWW
+7 QUIT
END ; -- End of code
+1 QUIT
