DGPPSYCH ;LIB/MKN,JAM - PRESUMPTIVE PSYCHOSIS SCREEN 7 ;08/01/2019
;;5.3;Registration;**977,1082**August 01, 2019;;Build 29
;
;ICRs
; Reference to ^%DT in ICR #10003
; Reference to ^DIQ in ICR #10004
; Reference to ^DIE in ICR #10018
; Reference to ^DIR in ICR #10026
; Reference to ^GET1^DIQ in ICR #2056
;
YN(DFN) ; DG*5.3*1082; NOTE: This API is now obsolete. Patch DG*5.3*1082 removed the call to this tag from the input template DG LOAD EDIT SCREEN 7
;
;This API gets called from input template DG LOAD EDIT SCREEN 7 at tag @705 (toward the end)
;Some of the variables NEWd here are because FileMan was crashing due to them getting killed in DIE
;
;;N DA,DGARR,DIC,DIE,DIK,DIR,DIROUT,DIRUT,DL,DP,DR,DTOUT,DUOUT,DGPPC,IEN331,IEN3312,Y
YN1 ;
;K DGARR D GETS^DIQ(2,DFN_",",".5601;1901","IE","DGARR")
;Q:$G(DGARR(2,DFN_",",1901,"I"))'="Y" ;Not VETERAN="YES"
;S DGPPC=$G(DGARR(2,DFN_",",.5601,"I"))
;K DIR S DIR(0)="Y",DIR("A")="PRESUMPTIVE PSYCHOSIS",DIR("B")=$S(DGPPC]"":"Y",1:"N") D ^DIR
;Q:$D(DIRUT)
;I 'Y D Q
;.S IEN331=$O(^DGPP(33.1,"B",DFN,"")) I IEN331 D
;..S DIK="^DGPP(33.1,",DA=IEN331 D ^DIK
;..S DIE="^DPT(",DA=DFN,DR=".5601///@" D ^DIE
;..Q
;.Q
;
;K DIR S DIR(0)="2,.5601AO",DIR("B")=DGPPC
;D ^DIR G:$D(DIRUT) YN1
;S DIE="^DPT(",DA=DFN,DR=".5601///"_Y_";" D ^DIE
Q
;
PT(DFN,DGCAT,DGCHGDT) ;
; DG*5.3*1082; Update Patient (#2) file field #.5601 and PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
; Inputs: DFN - patient
; DGCAT - category
; DGCHGDT - (Optional) The date the Category changed
; Output: Status - 0 (Error), 1 (Success)
;
N DGDATA5601
; Update Patient (#2) file, Presumptive Psychosis Category (#.5601)
S DGDATA5601(.5601)=DGCAT
I '$$UPD^DGENDBS(2,DFN,.DGDATA5601) Q 0
; Default DGCHGDT to DT if not passed in
I $G(DGCHGDT)="" S DGCHGDT=DT
; Update PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
Q $$CH(DFN,DGCHGDT)
;
CH(DFN,DGCHGDT) ;
; DG*5.3*1082; This code was originally trigger logic for PRESUMCPTIVE PSYCHOSIS CATEGORY field (#.5601) of the PATIENT file (#2)
; That trigger was removed by the patch and this logic modified and called by tag PT above. Parameter DGCHGDT added.
; Additional changes made to add error handling and return success/fail flag
;
; This code creates a top level entry into the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file if one does not exist
; If the PRESUMPTIVE PSYCHOSIS CATEGORY has changed, it sets a new entry into the PCATEGORY CHANGES multiple (#33.12) of the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
;
; Inputs: DFN - patient
; DGCHGDT - The date the Category changed
; Returns: 0 if error, 1 if successful
;
N DGCAT,DGERR,DGFDA,DGIEN331,DGIENS,DGX,DGIEN331,DGIEN331S
;
S DGCAT=$$GET1^DIQ(2,DFN_",",.5601,"I")
; Find existing entry for this patient, if any, in the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
S DGIEN331=$O(^DGPP(33.1,"B",DFN,"")),DGIEN331S=$S(DGIEN331:DGIEN331_",",1:"+1,")
; If Patient not currently in the file, add entry.
I 'DGIEN331 D I $D(DGERR) Q 0
. S DGFDA(33.1,DGIEN331S,.01)=DFN
. D UPDATE^DIE(,"DGFDA","DGIENS","DGERR")
. S DGIEN331=$G(DGIENS(1)),DGIEN331S=DGIEN331_","
;
; DGIEN331 now is the entry number for this patient in the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
; Check if the last entry in the CATEGORY CHANGES multiple (#33.12) of the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
; contains the same category as DGCAT. If so, quit - do not add same category for later date.
Q:$$EXISTS(DGIEN331,DGCAT) 1
;
; Create new entry in CATEGORY CHANGES multiple (#33.12)
Q $$SET(DGIEN331,DGCAT)
;
SET(DGIEN331,DGCAT) ;
; Inputs: DGIEN331 - IEN for the entry in the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file for this patient
; DGCAT - PRESUMPTIVE PSYCHOSIS CATEGORY (#.5061) field of PATIENT (#2) file (may be NULL)
; Returns: 0 if error, 1 if successful
;
; Create new entry in the CATEGORY CHANGES multiple (#33.12) of the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
N DGERR,DGFDA
;
S DGFDA(33.12,"+1,"_DGIEN331_",",.01)=DGCHGDT
S DGFDA(33.12,"+1,"_DGIEN331_",",.02)=DGCAT
S DGFDA(33.12,"+1,"_DGIEN331_",",.03)=$G(DUZ)
D UPDATE^DIE(,"DGFDA",,"DGERR")
I $D(DGERR) Q 0
Q 1
;
EXISTS(DGIEN331,DGCAT) ;
; Check if DGCAT is already the last entry in the CATEGORY CHANGES multiple (#33.12) of the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
;
; Inputs: DGIEN331 - IEN for the entry in the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
; DGCAT - PRESUMPTIVE PSYCHOSIS CATEGORY (#.5061) field of PATIENT (#2) file (may be NULL)
; Returns: 1 if DGCAT is already in the latest entry, 0 if DGCAT is not in the latest entry
;
N DGCATE,DGN
S DGN=$O(^DGPP(33.1,DGIEN331,"CH","B","@"),-1) Q:'DGN 0 S DGN=$O(^DGPP(33.1,DGIEN331,"CH","B",DGN,""),-1) Q:'DGN 0
S DGCATE=$P(^DGPP(33.1,DGIEN331,"CH",DGN,0),U,2)
Q $S(DGCATE=DGCAT:1,1:0)
;
GETDATA331(DFN,DGVAFPSY) ; Get Data
;
; Get most recent data from PPRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
;
; Input(s):
; DFN - internal entry number of Patient (#2) file
; Output(s):
; DGVAFPSY - Array populated with the most recent Presumptive Psychosis Data from the history
; Subscript Field# Data
; -------------- ------- ---------------------
; "PPCAT" .02 internal
; "PPCATDT" .01 internal
;
N DGIEN331,DGZHF,DGN,DGIENS
S DGIEN331=$O(^DGPP(33.1,"B",DFN,""))
I DGIEN331 D
. S DGN=$O(^DGPP(33.1,DGIEN331,"CH","B",""),-1) Q:'DGN
. S DGN=$O(^DGPP(33.1,DGIEN331,"CH","B",DGN,""),-1) Q:'DGN
. S DGIENS=DGN_","_DGIEN331_","
. S DGVAFPSY("PPCAT")=$$GET1^DIQ(33.12,DGIENS,.02,"I")
. S DGVAFPSY("PPCATDT")=$$GET1^DIQ(33.12,DGIENS,.01,"I")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPPSYCH 6015 printed Dec 13, 2024@02:50:59 Page 2
DGPPSYCH ;LIB/MKN,JAM - PRESUMPTIVE PSYCHOSIS SCREEN 7 ;08/01/2019
+1 ;;5.3;Registration;**977,1082**August 01, 2019;;Build 29
+2 ;
+3 ;ICRs
+4 ; Reference to ^%DT in ICR #10003
+5 ; Reference to ^DIQ in ICR #10004
+6 ; Reference to ^DIE in ICR #10018
+7 ; Reference to ^DIR in ICR #10026
+8 ; Reference to ^GET1^DIQ in ICR #2056
+9 ;
YN(DFN) ; DG*5.3*1082; NOTE: This API is now obsolete. Patch DG*5.3*1082 removed the call to this tag from the input template DG LOAD EDIT SCREEN 7
+1 ;
+2 ;This API gets called from input template DG LOAD EDIT SCREEN 7 at tag @705 (toward the end)
+3 ;Some of the variables NEWd here are because FileMan was crashing due to them getting killed in DIE
+4 ;
+5 ;;N DA,DGARR,DIC,DIE,DIK,DIR,DIROUT,DIRUT,DL,DP,DR,DTOUT,DUOUT,DGPPC,IEN331,IEN3312,Y
YN1 ;
+1 ;K DGARR D GETS^DIQ(2,DFN_",",".5601;1901","IE","DGARR")
+2 ;Q:$G(DGARR(2,DFN_",",1901,"I"))'="Y" ;Not VETERAN="YES"
+3 ;S DGPPC=$G(DGARR(2,DFN_",",.5601,"I"))
+4 ;K DIR S DIR(0)="Y",DIR("A")="PRESUMPTIVE PSYCHOSIS",DIR("B")=$S(DGPPC]"":"Y",1:"N") D ^DIR
+5 ;Q:$D(DIRUT)
+6 ;I 'Y D Q
+7 ;.S IEN331=$O(^DGPP(33.1,"B",DFN,"")) I IEN331 D
+8 ;..S DIK="^DGPP(33.1,",DA=IEN331 D ^DIK
+9 ;..S DIE="^DPT(",DA=DFN,DR=".5601///@" D ^DIE
+10 ;..Q
+11 ;.Q
+12 ;
+13 ;K DIR S DIR(0)="2,.5601AO",DIR("B")=DGPPC
+14 ;D ^DIR G:$D(DIRUT) YN1
+15 ;S DIE="^DPT(",DA=DFN,DR=".5601///"_Y_";" D ^DIE
+16 QUIT
+17 ;
PT(DFN,DGCAT,DGCHGDT) ;
+1 ; DG*5.3*1082; Update Patient (#2) file field #.5601 and PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
+2 ; Inputs: DFN - patient
+3 ; DGCAT - category
+4 ; DGCHGDT - (Optional) The date the Category changed
+5 ; Output: Status - 0 (Error), 1 (Success)
+6 ;
+7 NEW DGDATA5601
+8 ; Update Patient (#2) file, Presumptive Psychosis Category (#.5601)
+9 SET DGDATA5601(.5601)=DGCAT
+10 IF '$$UPD^DGENDBS(2,DFN,.DGDATA5601)
QUIT 0
+11 ; Default DGCHGDT to DT if not passed in
+12 IF $GET(DGCHGDT)=""
SET DGCHGDT=DT
+13 ; Update PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
+14 QUIT $$CH(DFN,DGCHGDT)
+15 ;
CH(DFN,DGCHGDT) ;
+1 ; DG*5.3*1082; This code was originally trigger logic for PRESUMCPTIVE PSYCHOSIS CATEGORY field (#.5601) of the PATIENT file (#2)
+2 ; That trigger was removed by the patch and this logic modified and called by tag PT above. Parameter DGCHGDT added.
+3 ; Additional changes made to add error handling and return success/fail flag
+4 ;
+5 ; This code creates a top level entry into the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file if one does not exist
+6 ; If the PRESUMPTIVE PSYCHOSIS CATEGORY has changed, it sets a new entry into the PCATEGORY CHANGES multiple (#33.12) of the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
+7 ;
+8 ; Inputs: DFN - patient
+9 ; DGCHGDT - The date the Category changed
+10 ; Returns: 0 if error, 1 if successful
+11 ;
+12 NEW DGCAT,DGERR,DGFDA,DGIEN331,DGIENS,DGX,DGIEN331,DGIEN331S
+13 ;
+14 SET DGCAT=$$GET1^DIQ(2,DFN_",",.5601,"I")
+15 ; Find existing entry for this patient, if any, in the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
+16 SET DGIEN331=$ORDER(^DGPP(33.1,"B",DFN,""))
SET DGIEN331S=$SELECT(DGIEN331:DGIEN331_",",1:"+1,")
+17 ; If Patient not currently in the file, add entry.
+18 IF 'DGIEN331
Begin DoDot:1
+19 SET DGFDA(33.1,DGIEN331S,.01)=DFN
+20 DO UPDATE^DIE(,"DGFDA","DGIENS","DGERR")
+21 SET DGIEN331=$GET(DGIENS(1))
SET DGIEN331S=DGIEN331_","
End DoDot:1
IF $DATA(DGERR)
QUIT 0
+22 ;
+23 ; DGIEN331 now is the entry number for this patient in the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
+24 ; Check if the last entry in the CATEGORY CHANGES multiple (#33.12) of the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
+25 ; contains the same category as DGCAT. If so, quit - do not add same category for later date.
+26 if $$EXISTS(DGIEN331,DGCAT)
QUIT 1
+27 ;
+28 ; Create new entry in CATEGORY CHANGES multiple (#33.12)
+29 QUIT $$SET(DGIEN331,DGCAT)
+30 ;
SET(DGIEN331,DGCAT) ;
+1 ; Inputs: DGIEN331 - IEN for the entry in the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file for this patient
+2 ; DGCAT - PRESUMPTIVE PSYCHOSIS CATEGORY (#.5061) field of PATIENT (#2) file (may be NULL)
+3 ; Returns: 0 if error, 1 if successful
+4 ;
+5 ; Create new entry in the CATEGORY CHANGES multiple (#33.12) of the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
+6 NEW DGERR,DGFDA
+7 ;
+8 SET DGFDA(33.12,"+1,"_DGIEN331_",",.01)=DGCHGDT
+9 SET DGFDA(33.12,"+1,"_DGIEN331_",",.02)=DGCAT
+10 SET DGFDA(33.12,"+1,"_DGIEN331_",",.03)=$GET(DUZ)
+11 DO UPDATE^DIE(,"DGFDA",,"DGERR")
+12 IF $DATA(DGERR)
QUIT 0
+13 QUIT 1
+14 ;
EXISTS(DGIEN331,DGCAT) ;
+1 ; Check if DGCAT is already the last entry in the CATEGORY CHANGES multiple (#33.12) of the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
+2 ;
+3 ; Inputs: DGIEN331 - IEN for the entry in the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
+4 ; DGCAT - PRESUMPTIVE PSYCHOSIS CATEGORY (#.5061) field of PATIENT (#2) file (may be NULL)
+5 ; Returns: 1 if DGCAT is already in the latest entry, 0 if DGCAT is not in the latest entry
+6 ;
+7 NEW DGCATE,DGN
+8 SET DGN=$ORDER(^DGPP(33.1,DGIEN331,"CH","B","@"),-1)
if 'DGN
QUIT 0
SET DGN=$ORDER(^DGPP(33.1,DGIEN331,"CH","B",DGN,""),-1)
if 'DGN
QUIT 0
+9 SET DGCATE=$PIECE(^DGPP(33.1,DGIEN331,"CH",DGN,0),U,2)
+10 QUIT $SELECT(DGCATE=DGCAT:1,1:0)
+11 ;
GETDATA331(DFN,DGVAFPSY) ; Get Data
+1 ;
+2 ; Get most recent data from PPRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
+3 ;
+4 ; Input(s):
+5 ; DFN - internal entry number of Patient (#2) file
+6 ; Output(s):
+7 ; DGVAFPSY - Array populated with the most recent Presumptive Psychosis Data from the history
+8 ; Subscript Field# Data
+9 ; -------------- ------- ---------------------
+10 ; "PPCAT" .02 internal
+11 ; "PPCATDT" .01 internal
+12 ;
+13 NEW DGIEN331,DGZHF,DGN,DGIENS
+14 SET DGIEN331=$ORDER(^DGPP(33.1,"B",DFN,""))
+15 IF DGIEN331
Begin DoDot:1
+16 SET DGN=$ORDER(^DGPP(33.1,DGIEN331,"CH","B",""),-1)
if 'DGN
QUIT
+17 SET DGN=$ORDER(^DGPP(33.1,DGIEN331,"CH","B",DGN,""),-1)
if 'DGN
QUIT
+18 SET DGIENS=DGN_","_DGIEN331_","
+19 SET DGVAFPSY("PPCAT")=$$GET1^DIQ(33.12,DGIENS,.02,"I")
+20 SET DGVAFPSY("PPCATDT")=$$GET1^DIQ(33.12,DGIENS,.01,"I")
End DoDot:1
+21 QUIT
