- 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 Jan 18, 2025@03:57:50 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^