DGNTQ ;ALB/RPM - NOSE/THROAT RADIUM TREATMENT QUESTIONS ; 8/24/01 12:59pm
;;5.3;Registration;**397**;Aug 13, 1993
Q
;
ASKSTAT(DGDIRA,DGDIRB,DGDIR0) ;
;
; Input
; DGDIR0 - DIR(0) string
; DGDIRA - DIR("A") string
; DGDIRB - DIR("B") string
;
; Output
; DGRSLT has the following values:
; 0 - if user up-arrows, times out, or enters null
; Y - user response
;
K DIRUT
S DIR(0)=DGDIR0
S DIR("A")=DGDIRA
S DIR("B")=DGDIRB
D ^DIR
K DIR
I $D(DIRUT) S DGRSLT=0
E S DGRSLT=Y
;
Q DGRSLT
;
REG(DGDFN) ;Entry point from REGISTRATION
;This sub-routine asks the Nose/Throat Radium Treatment questions
;for Screen 6 of LOAD/EDIT PATIENT DATA. The answers are filed in
;the NTR HISTORY file (#28.11) using the $$FILENTR^DGNTAPI API.
;A caret "^" entered as an answer to any of the questions will cause
;the sub-routine to QUIT without filing any data.
;A user possessing the DGNT VERIFY security key will have additional
;verification questions asked.
;
; Input
; DGDFN - IEN to PATIENT file (#2)
;
; Output none
;
N I,X,Y ;protect FileMan ^DIE variables
N DGNTIEN ;IEN from existing record from $$GETCUR API call
N DGNT ;data array from $$GETCUR API call
N DGDFLT ;default answer array
N DGUPD ;question response array subscripted by "NTR","AVI","SUB"
N DGRSLT ;result of filer API
N DGX ;generic counter
N DGXMT ;HL7 transmit flag
;
;initialize defaults
S DGNTIEN=$$GETCUR^DGNTAPI(DGDFN,"DGNT")
I 'DGNTIEN D
. F DGX="NTR","AVI","SUB","EDT","EUSR","HNC","HDT","HUSR","HSIT","VER","VDT","VUSR","VSIT" S DGUPD(DGX)=""
I +DGNTIEN>0,$D(DGNT) M DGUPD=DGNT
F DGX="NTR","AVI","SUB" D
. S DGDFLT(DGX)=$S($P(DGUPD(DGX),"^",2)]"":$P(DGUPD(DGX),"^",2),1:"NO")
;
;call reader API $$ASKSTAT passing DFN,DIR(0),DIR("B"),DIR("A")
S DGUPD("NTR")=$$ASKSTAT("Did you receive Nose or Throat Radium Treatments in the military? ",DGDFLT("NTR"),"28.11,.04AO")
Q:DGUPD("NTR")=0 ;user entered "^" or timed out
I DGUPD("NTR")="Y"!(DGUPD("NTR")="U") D
. S DGUPD("AVI")=$S($$DATOK(DGDFN,2550131):$$ASKSTAT("Did you serve as an aviator in the military before Jan 31, 1955? ",DGDFLT("AVI"),"28.11,.05AO"),1:"")
. Q:DGUPD("AVI")=0
. S DGUPD("SUB")=$S($$DATOK(DGDFN,2650101):$$ASKSTAT("Did you have submarine training in the military before Jan 1, 1965? ",DGDFLT("SUB"),"28.11,.06AO"),1:"")
;quit if user entered "^" or timed out during questions
I DGUPD("NTR")=0!(DGUPD("AVI")=0!(DGUPD("SUB")=0)) Q
;check for value change and add entry date, user, site and clear
;the previous verification/head&neck values
F DGX="NTR","AVI","SUB" I DGUPD(DGX)'=$P($G(DGNT(DGX)),"^") D Q
. S DGUPD("EDT")=$$NOW^XLFDT
. S DGUPD("EUSR")=DUZ
. I DGUPD("VDT")]"" D ;clear verification
. . F DGX="VER","VDT","VUSR","VSIT" S DGUPD(DGX)=""
. I DGUPD("HDT")]"" D ;clear Head/Neck DX
. . F DGX="HNC","HDT","HUSR","HSIT" S DGUPD(DGX)=""
;can user verify?
I $D(^XUSEC("DGNT VERIFY",DUZ)),(DGUPD("NTR")="Y"!(DGUPD("NTR")="U")) D VERIFY(DGDFN,.DGUPD)
;flip Unknown to Yes if verified by Mil Med Record
I DGUPD("NTR")="U",DGUPD("VER")="M" S DGUPD("NTR")="Y"
;file the data using filer API passing DFN and response array
F DGX="NTR","AVI","SUB","VER","HNC" S DGUPD(DGX)=$P(DGUPD(DGX),"^")
I $$CHANGE^DGNTUT(DGDFN,.DGUPD) D
. I DGUPD("NTR")="N" D
. . S DGUPD("VDT")=$$NOW^XLFDT
. . S DGUPD("VSIT")=$$SITE^DGNTUT
. S DGXMT=$S(DGUPD("VDT")'="":1,1:0)
. S DGRSLT=$$FILENTR^DGNTAPI(DGDFN,.DGUPD,DGXMT)
REGQ Q
;
VERIFY(DGDFN,DGVUPD) ;Ask verification questions
;
; Input
; DGDFN - IEN to PATIENT file (#2)
; DGVUPD - array of question responses
;
; Output none
;
N DGX ;generic index
N DGDFLT ;default answer array
;
;set up default answer array
S DGDFLT("VER")=$S($P($G(DGVUPD("VER")),"^",1)]"":$P(DGVUPD("VER"),"^",1),1:"")
S DGDFLT("HNC")=$S($P($G(DGVUPD("HNC")),"^",2)]"":$P(DGVUPD("HNC"),"^",2),1:"")
I $$ASKSTAT("Do you want to verify now? ","NO","YAO") D
. S DGVUPD("VER")=$$ASKSTAT("Nose and throat radium treatment verified by: ",DGDFLT("VER"),"28.11,1.01AO")
. I DGVUPD("VER")=0 S DGVUPD("VER")=DGDFLT("VER") Q
. I DGVUPD("VER")'=DGDFLT("VER") D
. . S DGVUPD("VDT")=$$NOW^XLFDT
. . S DGVUPD("VUSR")=DUZ
. . S DGVUPD("VSIT")=$$SITE^DGNTUT
. I DGVUPD("VER")'="N" D
. . S DGVUPD("HNC")=$$ASKSTAT("Has the veteran been diagnosed with Cancer of the Head and/or Neck? ",$S(DGDFLT("HNC")]"":DGDFLT("HNC"),1:"NO"),"28.11,2.01AO")
. . I DGVUPD("HNC")=0 S DGVUPD("HNC")=$E(DGDFLT("HNC")) Q
. . I DGVUPD("HNC")="N" S DGVUPD("HNC")=""
. . I DGVUPD("HNC")'=DGDFLT("HNC") D
. . . S DGVUPD("HDT")=$$NOW^XLFDT
. . . S DGVUPD("HUSR")=DUZ
. . . S DGVUPD("HSIT")=$$SITE^DGNTUT
Q
;
DATOK(DGDFN,DGDATE) ;Validate dates before asking questions
;Call $$SVCCHK to check Service Entry dates and if no Service
;Entry dates are found then at least validate against DOB.
;
; Input
; DGDFN - IEN to PATIENT file (#2)
; DGDATE- FM forumat date to validate agains
;
; Output
; DGRSLT - 0 = don't ask question
; 1 = ask question
;
N DGRSLT
S DGDFN=$G(DGDFN)
S DGDATE=$G(DGDATE)
S DGRSLT=1
S DGRSLT=$$SVCCHK(DGDFN,DGDATE)
I DGRSLT<0 S DGRSLT=$$DOBCHK(DGDFN,DGDATE)
Q DGRSLT
;
SVCCHK(DGDFN,DGDATE) ;Did veteran serve prior to DGDATE?
;This function searches the veteran's Service Entry dates to find the
;earliest date. If a Service Entry date is found then it is compared
;against the DGDATE parameter and returns a zero ("0") if DGDATE
;precedes the Service Entry date. If the Service Entry date precedes
;DGDATE a one ("1") is returned.
;
; Input
; DGDFN - IEN to PATIENT file (#2)
; DGDATE - FM format date to validate agains
;
; Output
; DGRSLT - 0 = DGDATE precedes earliest Service Entry date.
; 1 = Service Entry date precedes DGDATE
; -1 = no Service Entry date found.
;
N DFN,VASV,VAERR ;SVC^VADPT variables
N DGSVCE ;Service Entry date
N DGRSLT
S DGDFN=+$G(DGDFN)
S DGDATE=+$G(DGDATE)
S DGRSLT=-1
S DFN=DGDFN
D SVC^VADPT
F DGX=8:-1:6 I +$G(VASV(DGX,4))>0 D Q
. S DGRSLT=1
. I DGDATE<+$G(VASV(DGX,4)) S DGRSLT=0
Q DGRSLT
;
DOBCHK(DGDFN,DGDATE) ;Was veteran too young to have served at DGDATE?
;This function compares the veteran's DOB against DGDATE to determine
;if the veteran was less than 15 years old at DGDATE. This logic
;is based on POS^DGRPDD1.
;
; Input
; DGDFN - IEN to PATIENT file (#2)
; DGDATE- FM format date to validate against
;
; Output
; DGRSLT - 0 = veteran too young
; 1 = veteran old enough
;
N DFN,VA,VADM,VAERR ;DEM^VADPT variables
N DGDOB
N DGRSLT
S DGDFN=+$G(DGDFN)
S DGDATE=+$G(DGDATE)
S DGRSLT=1
S DFN=DGDFN
D DEM^VADPT
S DGDOB=+$G(VADM(3))
I DGDATE-DGDOB\10000<15 S DGRSLT=0
Q DGRSLT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGNTQ 6957 printed Sep 23, 2025@20:22:09 Page 2
DGNTQ ;ALB/RPM - NOSE/THROAT RADIUM TREATMENT QUESTIONS ; 8/24/01 12:59pm
+1 ;;5.3;Registration;**397**;Aug 13, 1993
+2 QUIT
+3 ;
ASKSTAT(DGDIRA,DGDIRB,DGDIR0) ;
+1 ;
+2 ; Input
+3 ; DGDIR0 - DIR(0) string
+4 ; DGDIRA - DIR("A") string
+5 ; DGDIRB - DIR("B") string
+6 ;
+7 ; Output
+8 ; DGRSLT has the following values:
+9 ; 0 - if user up-arrows, times out, or enters null
+10 ; Y - user response
+11 ;
+12 KILL DIRUT
+13 SET DIR(0)=DGDIR0
+14 SET DIR("A")=DGDIRA
+15 SET DIR("B")=DGDIRB
+16 DO ^DIR
+17 KILL DIR
+18 IF $DATA(DIRUT)
SET DGRSLT=0
+19 IF '$TEST
SET DGRSLT=Y
+20 ;
+21 QUIT DGRSLT
+22 ;
REG(DGDFN) ;Entry point from REGISTRATION
+1 ;This sub-routine asks the Nose/Throat Radium Treatment questions
+2 ;for Screen 6 of LOAD/EDIT PATIENT DATA. The answers are filed in
+3 ;the NTR HISTORY file (#28.11) using the $$FILENTR^DGNTAPI API.
+4 ;A caret "^" entered as an answer to any of the questions will cause
+5 ;the sub-routine to QUIT without filing any data.
+6 ;A user possessing the DGNT VERIFY security key will have additional
+7 ;verification questions asked.
+8 ;
+9 ; Input
+10 ; DGDFN - IEN to PATIENT file (#2)
+11 ;
+12 ; Output none
+13 ;
+14 ;protect FileMan ^DIE variables
NEW I,X,Y
+15 ;IEN from existing record from $$GETCUR API call
NEW DGNTIEN
+16 ;data array from $$GETCUR API call
NEW DGNT
+17 ;default answer array
NEW DGDFLT
+18 ;question response array subscripted by "NTR","AVI","SUB"
NEW DGUPD
+19 ;result of filer API
NEW DGRSLT
+20 ;generic counter
NEW DGX
+21 ;HL7 transmit flag
NEW DGXMT
+22 ;
+23 ;initialize defaults
+24 SET DGNTIEN=$$GETCUR^DGNTAPI(DGDFN,"DGNT")
+25 IF 'DGNTIEN
Begin DoDot:1
+26 FOR DGX="NTR","AVI","SUB","EDT","EUSR","HNC","HDT","HUSR","HSIT","VER","VDT","VUSR","VSIT"
SET DGUPD(DGX)=""
End DoDot:1
+27 IF +DGNTIEN>0
IF $DATA(DGNT)
MERGE DGUPD=DGNT
+28 FOR DGX="NTR","AVI","SUB"
Begin DoDot:1
+29 SET DGDFLT(DGX)=$SELECT($PIECE(DGUPD(DGX),"^",2)]"":$PIECE(DGUPD(DGX),"^",2),1:"NO")
End DoDot:1
+30 ;
+31 ;call reader API $$ASKSTAT passing DFN,DIR(0),DIR("B"),DIR("A")
+32 SET DGUPD("NTR")=$$ASKSTAT("Did you receive Nose or Throat Radium Treatments in the military? ",DGDFLT("NTR"),"28.11,.04AO")
+33 ;user entered "^" or timed out
if DGUPD("NTR")=0
QUIT
+34 IF DGUPD("NTR")="Y"!(DGUPD("NTR")="U")
Begin DoDot:1
+35 SET DGUPD("AVI")=$SELECT($$DATOK(DGDFN,2550131):$$ASKSTAT("Did you serve as an aviator in the military before Jan 31, 1955? ",DGDFLT("AVI"),"28.11,.05AO"),1:"")
+36 if DGUPD("AVI")=0
QUIT
+37 SET DGUPD("SUB")=$SELECT($$DATOK(DGDFN,2650101):$$ASKSTAT("Did you have submarine training in the military before Jan 1, 1965? ",DGDFLT("SUB"),"28.11,.06AO"),1:"")
End DoDot:1
+38 ;quit if user entered "^" or timed out during questions
+39 IF DGUPD("NTR")=0!(DGUPD("AVI")=0!(DGUPD("SUB")=0))
QUIT
+40 ;check for value change and add entry date, user, site and clear
+41 ;the previous verification/head&neck values
+42 FOR DGX="NTR","AVI","SUB"
IF DGUPD(DGX)'=$PIECE($GET(DGNT(DGX)),"^")
Begin DoDot:1
+43 SET DGUPD("EDT")=$$NOW^XLFDT
+44 SET DGUPD("EUSR")=DUZ
+45 ;clear verification
IF DGUPD("VDT")]""
Begin DoDot:2
+46 FOR DGX="VER","VDT","VUSR","VSIT"
SET DGUPD(DGX)=""
End DoDot:2
+47 ;clear Head/Neck DX
IF DGUPD("HDT")]""
Begin DoDot:2
+48 FOR DGX="HNC","HDT","HUSR","HSIT"
SET DGUPD(DGX)=""
End DoDot:2
End DoDot:1
QUIT
+49 ;can user verify?
+50 IF $DATA(^XUSEC("DGNT VERIFY",DUZ))
IF (DGUPD("NTR")="Y"!(DGUPD("NTR")="U"))
DO VERIFY(DGDFN,.DGUPD)
+51 ;flip Unknown to Yes if verified by Mil Med Record
+52 IF DGUPD("NTR")="U"
IF DGUPD("VER")="M"
SET DGUPD("NTR")="Y"
+53 ;file the data using filer API passing DFN and response array
+54 FOR DGX="NTR","AVI","SUB","VER","HNC"
SET DGUPD(DGX)=$PIECE(DGUPD(DGX),"^")
+55 IF $$CHANGE^DGNTUT(DGDFN,.DGUPD)
Begin DoDot:1
+56 IF DGUPD("NTR")="N"
Begin DoDot:2
+57 SET DGUPD("VDT")=$$NOW^XLFDT
+58 SET DGUPD("VSIT")=$$SITE^DGNTUT
End DoDot:2
+59 SET DGXMT=$SELECT(DGUPD("VDT")'="":1,1:0)
+60 SET DGRSLT=$$FILENTR^DGNTAPI(DGDFN,.DGUPD,DGXMT)
End DoDot:1
REGQ QUIT
+1 ;
VERIFY(DGDFN,DGVUPD) ;Ask verification questions
+1 ;
+2 ; Input
+3 ; DGDFN - IEN to PATIENT file (#2)
+4 ; DGVUPD - array of question responses
+5 ;
+6 ; Output none
+7 ;
+8 ;generic index
NEW DGX
+9 ;default answer array
NEW DGDFLT
+10 ;
+11 ;set up default answer array
+12 SET DGDFLT("VER")=$SELECT($PIECE($GET(DGVUPD("VER")),"^",1)]"":$PIECE(DGVUPD("VER"),"^",1),1:"")
+13 SET DGDFLT("HNC")=$SELECT($PIECE($GET(DGVUPD("HNC")),"^",2)]"":$PIECE(DGVUPD("HNC"),"^",2),1:"")
+14 IF $$ASKSTAT("Do you want to verify now? ","NO","YAO")
Begin DoDot:1
+15 SET DGVUPD("VER")=$$ASKSTAT("Nose and throat radium treatment verified by: ",DGDFLT("VER"),"28.11,1.01AO")
+16 IF DGVUPD("VER")=0
SET DGVUPD("VER")=DGDFLT("VER")
QUIT
+17 IF DGVUPD("VER")'=DGDFLT("VER")
Begin DoDot:2
+18 SET DGVUPD("VDT")=$$NOW^XLFDT
+19 SET DGVUPD("VUSR")=DUZ
+20 SET DGVUPD("VSIT")=$$SITE^DGNTUT
End DoDot:2
+21 IF DGVUPD("VER")'="N"
Begin DoDot:2
+22 SET DGVUPD("HNC")=$$ASKSTAT("Has the veteran been diagnosed with Cancer of the Head and/or Neck? ",$SELECT(DGDFLT("HNC")]"":DGDFLT("HNC"),1:"NO"),"28.11,2.01AO")
+23 IF DGVUPD("HNC")=0
SET DGVUPD("HNC")=$EXTRACT(DGDFLT("HNC"))
QUIT
+24 IF DGVUPD("HNC")="N"
SET DGVUPD("HNC")=""
+25 IF DGVUPD("HNC")'=DGDFLT("HNC")
Begin DoDot:3
+26 SET DGVUPD("HDT")=$$NOW^XLFDT
+27 SET DGVUPD("HUSR")=DUZ
+28 SET DGVUPD("HSIT")=$$SITE^DGNTUT
End DoDot:3
End DoDot:2
End DoDot:1
+29 QUIT
+30 ;
DATOK(DGDFN,DGDATE) ;Validate dates before asking questions
+1 ;Call $$SVCCHK to check Service Entry dates and if no Service
+2 ;Entry dates are found then at least validate against DOB.
+3 ;
+4 ; Input
+5 ; DGDFN - IEN to PATIENT file (#2)
+6 ; DGDATE- FM forumat date to validate agains
+7 ;
+8 ; Output
+9 ; DGRSLT - 0 = don't ask question
+10 ; 1 = ask question
+11 ;
+12 NEW DGRSLT
+13 SET DGDFN=$GET(DGDFN)
+14 SET DGDATE=$GET(DGDATE)
+15 SET DGRSLT=1
+16 SET DGRSLT=$$SVCCHK(DGDFN,DGDATE)
+17 IF DGRSLT<0
SET DGRSLT=$$DOBCHK(DGDFN,DGDATE)
+18 QUIT DGRSLT
+19 ;
SVCCHK(DGDFN,DGDATE) ;Did veteran serve prior to DGDATE?
+1 ;This function searches the veteran's Service Entry dates to find the
+2 ;earliest date. If a Service Entry date is found then it is compared
+3 ;against the DGDATE parameter and returns a zero ("0") if DGDATE
+4 ;precedes the Service Entry date. If the Service Entry date precedes
+5 ;DGDATE a one ("1") is returned.
+6 ;
+7 ; Input
+8 ; DGDFN - IEN to PATIENT file (#2)
+9 ; DGDATE - FM format date to validate agains
+10 ;
+11 ; Output
+12 ; DGRSLT - 0 = DGDATE precedes earliest Service Entry date.
+13 ; 1 = Service Entry date precedes DGDATE
+14 ; -1 = no Service Entry date found.
+15 ;
+16 ;SVC^VADPT variables
NEW DFN,VASV,VAERR
+17 ;Service Entry date
NEW DGSVCE
+18 NEW DGRSLT
+19 SET DGDFN=+$GET(DGDFN)
+20 SET DGDATE=+$GET(DGDATE)
+21 SET DGRSLT=-1
+22 SET DFN=DGDFN
+23 DO SVC^VADPT
+24 FOR DGX=8:-1:6
IF +$GET(VASV(DGX,4))>0
Begin DoDot:1
+25 SET DGRSLT=1
+26 IF DGDATE<+$GET(VASV(DGX,4))
SET DGRSLT=0
End DoDot:1
QUIT
+27 QUIT DGRSLT
+28 ;
DOBCHK(DGDFN,DGDATE) ;Was veteran too young to have served at DGDATE?
+1 ;This function compares the veteran's DOB against DGDATE to determine
+2 ;if the veteran was less than 15 years old at DGDATE. This logic
+3 ;is based on POS^DGRPDD1.
+4 ;
+5 ; Input
+6 ; DGDFN - IEN to PATIENT file (#2)
+7 ; DGDATE- FM format date to validate against
+8 ;
+9 ; Output
+10 ; DGRSLT - 0 = veteran too young
+11 ; 1 = veteran old enough
+12 ;
+13 ;DEM^VADPT variables
NEW DFN,VA,VADM,VAERR
+14 NEW DGDOB
+15 NEW DGRSLT
+16 SET DGDFN=+$GET(DGDFN)
+17 SET DGDATE=+$GET(DGDATE)
+18 SET DGRSLT=1
+19 SET DFN=DGDFN
+20 DO DEM^VADPT
+21 SET DGDOB=+$GET(VADM(3))
+22 IF DGDATE-DGDOB\10000<15
SET DGRSLT=0
+23 QUIT DGRSLT
+24 ;
