Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPPSYCH

DGPPSYCH.m

Go to the documentation of this file.
  1. DGPPSYCH ;LIB/MKN,JAM - PRESUMPTIVE PSYCHOSIS SCREEN 7 ;08/01/2019
  1. ;;5.3;Registration;**977,1082**August 01, 2019;;Build 29
  1. ;
  1. ;ICRs
  1. ; Reference to ^%DT in ICR #10003
  1. ; Reference to ^DIQ in ICR #10004
  1. ; Reference to ^DIE in ICR #10018
  1. ; Reference to ^DIR in ICR #10026
  1. ; Reference to ^GET1^DIQ in ICR #2056
  1. ;
  1. 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. ;
  1. ;This API gets called from input template DG LOAD EDIT SCREEN 7 at tag @705 (toward the end)
  1. ;Some of the variables NEWd here are because FileMan was crashing due to them getting killed in DIE
  1. ;
  1. ;;N DA,DGARR,DIC,DIE,DIK,DIR,DIROUT,DIRUT,DL,DP,DR,DTOUT,DUOUT,DGPPC,IEN331,IEN3312,Y
  1. YN1 ;
  1. ;K DGARR D GETS^DIQ(2,DFN_",",".5601;1901","IE","DGARR")
  1. ;Q:$G(DGARR(2,DFN_",",1901,"I"))'="Y" ;Not VETERAN="YES"
  1. ;S DGPPC=$G(DGARR(2,DFN_",",.5601,"I"))
  1. ;K DIR S DIR(0)="Y",DIR("A")="PRESUMPTIVE PSYCHOSIS",DIR("B")=$S(DGPPC]"":"Y",1:"N") D ^DIR
  1. ;Q:$D(DIRUT)
  1. ;I 'Y D Q
  1. ;.S IEN331=$O(^DGPP(33.1,"B",DFN,"")) I IEN331 D
  1. ;..S DIK="^DGPP(33.1,",DA=IEN331 D ^DIK
  1. ;..S DIE="^DPT(",DA=DFN,DR=".5601///@" D ^DIE
  1. ;..Q
  1. ;.Q
  1. ;
  1. ;K DIR S DIR(0)="2,.5601AO",DIR("B")=DGPPC
  1. ;D ^DIR G:$D(DIRUT) YN1
  1. ;S DIE="^DPT(",DA=DFN,DR=".5601///"_Y_";" D ^DIE
  1. Q
  1. ;
  1. PT(DFN,DGCAT,DGCHGDT) ;
  1. ; DG*5.3*1082; Update Patient (#2) file field #.5601 and PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
  1. ; Inputs: DFN - patient
  1. ; DGCAT - category
  1. ; DGCHGDT - (Optional) The date the Category changed
  1. ; Output: Status - 0 (Error), 1 (Success)
  1. ;
  1. N DGDATA5601
  1. ; Update Patient (#2) file, Presumptive Psychosis Category (#.5601)
  1. S DGDATA5601(.5601)=DGCAT
  1. I '$$UPD^DGENDBS(2,DFN,.DGDATA5601) Q 0
  1. ; Default DGCHGDT to DT if not passed in
  1. I $G(DGCHGDT)="" S DGCHGDT=DT
  1. ; Update PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
  1. Q $$CH(DFN,DGCHGDT)
  1. ;
  1. 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)
  1. ; That trigger was removed by the patch and this logic modified and called by tag PT above. Parameter DGCHGDT added.
  1. ; Additional changes made to add error handling and return success/fail flag
  1. ;
  1. ; This code creates a top level entry into the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file if one does not exist
  1. ; 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
  1. ;
  1. ; Inputs: DFN - patient
  1. ; DGCHGDT - The date the Category changed
  1. ; Returns: 0 if error, 1 if successful
  1. ;
  1. N DGCAT,DGERR,DGFDA,DGIEN331,DGIENS,DGX,DGIEN331,DGIEN331S
  1. ;
  1. S DGCAT=$$GET1^DIQ(2,DFN_",",.5601,"I")
  1. ; Find existing entry for this patient, if any, in the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
  1. S DGIEN331=$O(^DGPP(33.1,"B",DFN,"")),DGIEN331S=$S(DGIEN331:DGIEN331_",",1:"+1,")
  1. ; If Patient not currently in the file, add entry.
  1. I 'DGIEN331 D I $D(DGERR) Q 0
  1. . S DGFDA(33.1,DGIEN331S,.01)=DFN
  1. . D UPDATE^DIE(,"DGFDA","DGIENS","DGERR")
  1. . S DGIEN331=$G(DGIENS(1)),DGIEN331S=DGIEN331_","
  1. ;
  1. ; DGIEN331 now is the entry number for this patient in the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
  1. ; Check if the last entry in the CATEGORY CHANGES multiple (#33.12) of the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
  1. ; contains the same category as DGCAT. If so, quit - do not add same category for later date.
  1. Q:$$EXISTS(DGIEN331,DGCAT) 1
  1. ;
  1. ; Create new entry in CATEGORY CHANGES multiple (#33.12)
  1. Q $$SET(DGIEN331,DGCAT)
  1. ;
  1. SET(DGIEN331,DGCAT) ;
  1. ; Inputs: DGIEN331 - IEN for the entry in the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file for this patient
  1. ; DGCAT - PRESUMPTIVE PSYCHOSIS CATEGORY (#.5061) field of PATIENT (#2) file (may be NULL)
  1. ; Returns: 0 if error, 1 if successful
  1. ;
  1. ; Create new entry in the CATEGORY CHANGES multiple (#33.12) of the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
  1. N DGERR,DGFDA
  1. ;
  1. S DGFDA(33.12,"+1,"_DGIEN331_",",.01)=DGCHGDT
  1. S DGFDA(33.12,"+1,"_DGIEN331_",",.02)=DGCAT
  1. S DGFDA(33.12,"+1,"_DGIEN331_",",.03)=$G(DUZ)
  1. D UPDATE^DIE(,"DGFDA",,"DGERR")
  1. I $D(DGERR) Q 0
  1. Q 1
  1. ;
  1. 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
  1. ;
  1. ; Inputs: DGIEN331 - IEN for the entry in the PRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
  1. ; DGCAT - PRESUMPTIVE PSYCHOSIS CATEGORY (#.5061) field of PATIENT (#2) file (may be NULL)
  1. ; Returns: 1 if DGCAT is already in the latest entry, 0 if DGCAT is not in the latest entry
  1. ;
  1. N DGCATE,DGN
  1. 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
  1. S DGCATE=$P(^DGPP(33.1,DGIEN331,"CH",DGN,0),U,2)
  1. Q $S(DGCATE=DGCAT:1,1:0)
  1. ;
  1. GETDATA331(DFN,DGVAFPSY) ; Get Data
  1. ;
  1. ; Get most recent data from PPRESUMPTIVE PSYCHOSIS CATEGORY CHANGES (#33.1) file
  1. ;
  1. ; Input(s):
  1. ; DFN - internal entry number of Patient (#2) file
  1. ; Output(s):
  1. ; DGVAFPSY - Array populated with the most recent Presumptive Psychosis Data from the history
  1. ; Subscript Field# Data
  1. ; -------------- ------- ---------------------
  1. ; "PPCAT" .02 internal
  1. ; "PPCATDT" .01 internal
  1. ;
  1. N DGIEN331,DGZHF,DGN,DGIENS
  1. S DGIEN331=$O(^DGPP(33.1,"B",DFN,""))
  1. I DGIEN331 D
  1. . S DGN=$O(^DGPP(33.1,DGIEN331,"CH","B",""),-1) Q:'DGN
  1. . S DGN=$O(^DGPP(33.1,DGIEN331,"CH","B",DGN,""),-1) Q:'DGN
  1. . S DGIENS=DGN_","_DGIEN331_","
  1. . S DGVAFPSY("PPCAT")=$$GET1^DIQ(33.12,DGIENS,.02,"I")
  1. . S DGVAFPSY("PPCATDT")=$$GET1^DIQ(33.12,DGIENS,.01,"I")
  1. Q