- 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 Mar 13, 2025@21:31:20 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
