DGRPU1 ;ALB/REW,JAM - CUSTOM LOAD/EDIT SCREEN UTILITIES ;19 Oct 2017 3:02 PM
;;5.3;Registration;**139,169,415,527,508,664,941**;Aug 13, 1993;Build 73
;
; *941* - JAM; 1. Tag QNUM modified for new field reference numbers used in ^DGRPE due to redesign of Screen layouts for screen 1 and 1.1
; Previous values: ^104^105^109,105,112^109,105,111^111^
; New values: ^108^113^109,113,104^109,113,114^114^
;
QUES(DFN,DGQCODE) ; EDIT SPECIFIC PORTIONS OF REGISTRATION DATA
;
; INPUT:
; DFN
; DGQCODE = Code for question(s) to be asked
; OUTPUT:
; DGERR = ERROR VARIABLE
; DGCHANGE= 1 IF DATA MODIFIED 0 O/W
; USED:
; DGPTND = Prior value(s) of Patient File node(s) [array]
; DGQNODES= Node(s) used above
; DGNODE = Single node
; DGDR = edit=screen*10+item #
; DGRPS = Screen #
; DGCODE = CODE used by ^DGRPE
; DGQ = String of ^DGCODE^DGCODE etc.
; DGPC = Piece Number
; DGX = Line Tag offset
;
N D,D0,DI,DIC,DGCODE,DGDR,DGNODE,DGQNODES,DGPC,DGPTND,DGRPS,DGQ,DGX
N DQ,N,X,Y,%Y,DGPTNDM
S (DGERR,DGRPS,DGCHANGE)=0
I '($G(DFN)&$D(DGQCODE)) G QTE
F DGX=1:1 S DGQ=$T(QDES+DGX) Q:DGQ[(U_DGQCODE_U)!(DGQ']"")
F DGPC=2:1 S DGCODE=$P(DGQ,U,DGPC) Q:(DGCODE']"")!(DGCODE=DGQCODE)
G:DGCODE']"" QTE
S DGDR=$P($T(QNUM+DGX),U,DGPC)
S DGRPS=DGDR\100
S DGQNODES=$P($T(QNODE+DGX),U,DGPC)
F N=1:1 S DGNODE=$P(DGQNODES,"~",N) Q:DGNODE']"" S DGPTND(DGNODE)=$G(^DPT(DFN,DGNODE))
S DGQNODES=$P($T(MNODE+DGX),U,DGPC)
F N=1:1 S DGNODE=$P(DGQNODES,"~",N) Q:DGNODE']"" M DGPTNDM(DGNODE)=^DPT(DFN,DGNODE) S DGPTNDM(DGNODE)=""
D ^DGRPE
F DGNODE=0:0 S DGNODE=$O(DGPTND(DGNODE)) Q:DGNODE']"" S:$G(^DPT(DFN,DGNODE))'=(DGPTND(DGNODE)) DGCHANGE=1
S DGNODE="" F S DGNODE=$O(DGPTNDM(DGNODE)) Q:DGNODE']"" D Q:DGCHANGE
.S X=0 F S X=$O(DGPTNDM(DGNODE,X)) Q:'X D Q:DGCHANGE
..S Y="" F S Y=$O(DGPTNDM(DGNODE,X,Y)) Q:Y']"" D Q:DGCHANGE
...I $G(^DPT(DFN,DGNODE,X,Y))'=DGPTNDM(DGNODE,X,Y) S DGCHANGE=1
.Q:DGCHANGE
.S X=0 F S X=$O(^DPT(DGNODE,X)) Q:'X D Q:DGCHANGE
..S Y="" F S Y=$O(^DPT(DGNODE,X,Y)) Q:Y']"" D Q:DGCHANGE
...I $G(^DPT(DFN,DGNODE,X,Y))'=DGPTNDM(DGNODE,X,Y) S DGCHANGE=1
QTE I 'DGRPS S DGERR=1
QTQ Q
QDES ;MNEMONIC - DGQCODE should match with one of these
;;^ADD1^ADD2^ADD^ADD3^ADD4^
QNUM ;REFERENCE NUMBERS USED TO SET DGDR FOR USE BY ^DGRPE
;;^108^113^109,113,104^109,113,114^114^
QNODE ;;NODES OF THE PATIENT FILE
;;^.11~.13^.121^.11~.121~.13^.11~.121~.13~.141^.141^
;;
MNODE ;;MULTIPLES OF THE PATIENT FILE
;;^^^.02~.06^.02~.06~.14^.14^
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRPU1 2639 printed Apr 09, 2024@21:43:01 Page 2
DGRPU1 ;ALB/REW,JAM - CUSTOM LOAD/EDIT SCREEN UTILITIES ;19 Oct 2017 3:02 PM
+1 ;;5.3;Registration;**139,169,415,527,508,664,941**;Aug 13, 1993;Build 73
+2 ;
+3 ; *941* - JAM; 1. Tag QNUM modified for new field reference numbers used in ^DGRPE due to redesign of Screen layouts for screen 1 and 1.1
+4 ; Previous values: ^104^105^109,105,112^109,105,111^111^
+5 ; New values: ^108^113^109,113,104^109,113,114^114^
+6 ;
QUES(DFN,DGQCODE) ; EDIT SPECIFIC PORTIONS OF REGISTRATION DATA
+1 ;
+2 ; INPUT:
+3 ; DFN
+4 ; DGQCODE = Code for question(s) to be asked
+5 ; OUTPUT:
+6 ; DGERR = ERROR VARIABLE
+7 ; DGCHANGE= 1 IF DATA MODIFIED 0 O/W
+8 ; USED:
+9 ; DGPTND = Prior value(s) of Patient File node(s) [array]
+10 ; DGQNODES= Node(s) used above
+11 ; DGNODE = Single node
+12 ; DGDR = edit=screen*10+item #
+13 ; DGRPS = Screen #
+14 ; DGCODE = CODE used by ^DGRPE
+15 ; DGQ = String of ^DGCODE^DGCODE etc.
+16 ; DGPC = Piece Number
+17 ; DGX = Line Tag offset
+18 ;
+19 NEW D,D0,DI,DIC,DGCODE,DGDR,DGNODE,DGQNODES,DGPC,DGPTND,DGRPS,DGQ,DGX
+20 NEW DQ,N,X,Y,%Y,DGPTNDM
+21 SET (DGERR,DGRPS,DGCHANGE)=0
+22 IF '($GET(DFN)&$DATA(DGQCODE))
GOTO QTE
+23 FOR DGX=1:1
SET DGQ=$TEXT(QDES+DGX)
if DGQ[(U_DGQCODE_U)!(DGQ']"")
QUIT
+24 FOR DGPC=2:1
SET DGCODE=$PIECE(DGQ,U,DGPC)
if (DGCODE']"")!(DGCODE=DGQCODE)
QUIT
+25 if DGCODE']""
GOTO QTE
+26 SET DGDR=$PIECE($TEXT(QNUM+DGX),U,DGPC)
+27 SET DGRPS=DGDR\100
+28 SET DGQNODES=$PIECE($TEXT(QNODE+DGX),U,DGPC)
+29 FOR N=1:1
SET DGNODE=$PIECE(DGQNODES,"~",N)
if DGNODE']""
QUIT
SET DGPTND(DGNODE)=$GET(^DPT(DFN,DGNODE))
+30 SET DGQNODES=$PIECE($TEXT(MNODE+DGX),U,DGPC)
+31 FOR N=1:1
SET DGNODE=$PIECE(DGQNODES,"~",N)
if DGNODE']""
QUIT
MERGE DGPTNDM(DGNODE)=^DPT(DFN,DGNODE)
SET DGPTNDM(DGNODE)=""
+32 DO ^DGRPE
+33 FOR DGNODE=0:0
SET DGNODE=$ORDER(DGPTND(DGNODE))
if DGNODE']""
QUIT
if $GET(^DPT(DFN,DGNODE))'=(DGPTND(DGNODE))
SET DGCHANGE=1
+34 SET DGNODE=""
FOR
SET DGNODE=$ORDER(DGPTNDM(DGNODE))
if DGNODE']""
QUIT
Begin DoDot:1
+35 SET X=0
FOR
SET X=$ORDER(DGPTNDM(DGNODE,X))
if 'X
QUIT
Begin DoDot:2
+36 SET Y=""
FOR
SET Y=$ORDER(DGPTNDM(DGNODE,X,Y))
if Y']""
QUIT
Begin DoDot:3
+37 IF $GET(^DPT(DFN,DGNODE,X,Y))'=DGPTNDM(DGNODE,X,Y)
SET DGCHANGE=1
End DoDot:3
if DGCHANGE
QUIT
End DoDot:2
if DGCHANGE
QUIT
+38 if DGCHANGE
QUIT
+39 SET X=0
FOR
SET X=$ORDER(^DPT(DGNODE,X))
if 'X
QUIT
Begin DoDot:2
+40 SET Y=""
FOR
SET Y=$ORDER(^DPT(DGNODE,X,Y))
if Y']""
QUIT
Begin DoDot:3
+41 IF $GET(^DPT(DFN,DGNODE,X,Y))'=DGPTNDM(DGNODE,X,Y)
SET DGCHANGE=1
End DoDot:3
if DGCHANGE
QUIT
End DoDot:2
if DGCHANGE
QUIT
End DoDot:1
if DGCHANGE
QUIT
QTE IF 'DGRPS
SET DGERR=1
QTQ QUIT
QDES ;MNEMONIC - DGQCODE should match with one of these
+1 ;;^ADD1^ADD2^ADD^ADD3^ADD4^
QNUM ;REFERENCE NUMBERS USED TO SET DGDR FOR USE BY ^DGRPE
+1 ;;^108^113^109,113,104^109,113,114^114^
QNODE ;;NODES OF THE PATIENT FILE
+1 ;;^.11~.13^.121^.11~.121~.13^.11~.121~.13~.141^.141^
+2 ;;
MNODE ;;MULTIPLES OF THE PATIENT FILE
+1 ;;^^^.02~.06^.02~.06~.14^.14^
