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

DGCOMPACT.m

Go to the documentation of this file.
  1. DGCOMPACT ;ALB/BPA,CMC - Routine for COMPACT Act processing the DG;12/18/2023@9:26am
  1. ;;5.3;Registration;**1104**;Aug 13, 1993;Build 59
  1. ; *1104* APIs for COMPACT Act processing
  1. ; Reference to VISIT^PXCOMPACT in ICR #7327
  1. ;
  1. SETPTFFLG(DGENC,DGVAL) ;
  1. ; API to set TRT FOR ACUTE SUICIDAL CRISIS flag in PTF 101
  1. ; DGENC - Encounter ID (PTF IEN)
  1. ; DGVAL - Value to set into flag
  1. ; For YES: D SETPTFFLG^DGCOMPACT(DGENC,1)
  1. ; For NO: D SETPTFFLG^DGCOMPACT(DGENC,0)
  1. ; For NULL: D SETPTFFLG^DGCOMPACT(DGENC,"")
  1. ; Create a 70 level in the PTF file if it is not set
  1. I $G(^DGPT(DGENC,70))="" S ^DGPT(DGENC,70)=""
  1. S $P(^DGPT(DGENC,70),"^",33)=DGVAL
  1. Q
  1. ;
  1. SETPTFMVMT(DGENC,DGVAL,DGSEQ) ;
  1. ; API to set TREATMENT FOR SUICIDAL CRISIS flag in PTF 501
  1. ; DGENC - Encounter ID (PTF IEN)
  1. ; DGVAL - Value to set into flag
  1. ; DGSEQ - Movement sequence *not required
  1. ; For YES: D SETPTFMVMT^DGCOMPACT(DGENC,"Y",DGSEQ)
  1. ; For NO: D SETPTFMVMT^DGCOMPACT(DGENC,"N",DGSEQ)
  1. ; For NULL: D SETPTFMVMT^DGCOMPACT(DGENC,"",DGSEQ)
  1. ; When setting a sequence other than the first one, pass the sequence number
  1. I $G(DGSEQ)'="" S $P(^DGPT(DGENC,"M",DGSEQ,0),"^",33)=DGVAL
  1. ; Whenever a new movement is created for a PTF, it becomes the 1 node of the subfile.
  1. E S $P(^DGPT(DGENC,"M",1,0),"^",33)=DGVAL
  1. Q
  1. ;
  1. EDITADMIT(PTF) ;
  1. N ADMTYP,DFN,DGSTDT
  1. S DFN=$P(^UTILITY($J,"PXCOMPACT"),"^",1),DGSTDT=$P(^UTILITY($J,"PXCOMPACT"),"^",2),ADMTYP=$P(^UTILITY($J,"PXCOMPACT"),"^",3)
  1. D ADMIT^PXCOMPACT(DFN,DGSTDT,ADMTYP,PTF)
  1. K ^UTILITY($J,"PXCOMPACT"),DGSTDT,ADMTYP
  1. Q
  1. ;
  1. QUERY ;
  1. ;query the COMPACT ACT TRANSACTION LOG file and display contents
  1. N COUNT,DATA,ICN,RECORD,REQ,REQUEST,RESP,RESPCODE,RESPDATE,ROUTINE,RSEQ,SEQ,SITE
  1. I '$D(^DGCOMP(33.3,"B")) W !,"Data Not Available" Q
  1. S ICN=""
  1. F S ICN=$O(^DGCOMP(33.3,"B",ICN)) Q:ICN="" D
  1. . S SEQ=""
  1. . F S SEQ=$O(^DGCOMP(33.3,"B",ICN,SEQ)) Q:SEQ="" D
  1. . . S RECORD=^DGCOMP(33.3,SEQ,0)
  1. . . S ROUTINE=$P(RECORD,"^",2),REQUEST=$P(RECORD,"^",3),RESPCODE=$P(RECORD,"^",4),RESPDATE=$P(RECORD,"^",5)
  1. . . S ROUTINE=$S($P(RECORD,"^",2)="":"NO ROUTINE",1:$P(RECORD,"^",2))
  1. . . I $D(ROUTINE(ROUTINE,"ICN",ICN)) D Q
  1. . . . S ROUTINE(ROUTINE,"ICN",ICN,$O(ROUTINE(ROUTINE,"ICN",ICN,""))+1)=REQUEST_"^"_RESPDATE_"^"_RESPCODE
  1. . . . S ROUTINE(ROUTINE,"COUNT")=$G(ROUTINE(ROUTINE,"COUNT"))+1
  1. . . S ROUTINE(ROUTINE,"ICN",ICN,1)=REQUEST_"^"_RESPDATE_"^"_RESPCODE,ROUTINE(ROUTINE,"COUNT")=$G(ROUTINE(ROUTINE,"COUNT"))+1
  1. . . Q
  1. . Q
  1. ;now display data in desired format
  1. S SITE=$P($$SITE^VASITE,"^",1)
  1. W !,"Site # ",SITE
  1. S ROUTINE=""
  1. F S ROUTINE=$O(ROUTINE(ROUTINE)) Q:ROUTINE="" D
  1. . S COUNT=ROUTINE(ROUTINE,"COUNT")
  1. . W !!,"Calling Routine: ",ROUTINE," Request Count: ",COUNT
  1. . S ICN=""
  1. . F S ICN=$O(ROUTINE(ROUTINE,"ICN",ICN)) Q:ICN="" D
  1. . . W !,ICN
  1. . . S RSEQ=""
  1. . . F S RSEQ=$O(ROUTINE(ROUTINE,"ICN",ICN,RSEQ)) Q:RSEQ="" D
  1. . . . S DATA=ROUTINE(ROUTINE,"ICN",ICN,RSEQ)
  1. . . . S REQ=$$FMTE^XLFDT($P(DATA,"^",1)),RESP=$$FMTE^XLFDT($P(DATA,"^",2)),RESPCODE=$P(DATA,"^",3)
  1. . . . W !," Request: ",$S($L(REQ)=18:REQ_":00",1:REQ)
  1. . . . W !," Response: ",$S($L(RESP)=18:RESP_":00",1:RESP)," ",$TR(RESPCODE,"~","^"),!
  1. Q
  1. ADMIT(DFN,PTF) ;
  1. GO N %,DA,DEF,PXNWSTDT,STDT
  1. W !!,"ADMITTED FOR ACUTE SUICIDAL CRISIS" S %=2 D YN^DICN I %=-1 G GO
  1. I (%=2),($G(PTF)'="") D RETRACT^PXCOMPACTEOC(DFN,PTF)
  1. I %=1 D
  1. . W !," THIS ADMISSION WILL BEGIN THE COMPACT ACT BENEFIT. ARE YOU SURE" S %=2 D YN^DICN I %'=1 G GO
  1. I ($$ASC^PXCOMPACT(DFN)="Y"),($$GETIPDT^PXCOMPACT(DFN)'=""),($$GETBENTYP^PXCOMPACT(DFN)="O") D
  1. . S PXNWSTDT=$$GETSTDT^PXCOMPACT(DFN)
  1. DT ;
  1. I %=1 D
  1. . W !," ACUTE SUICIDAL CRISIS START DATE?: NOW//" R STDT:30
  1. . I $G(STDT)="" S STDT="NOW"
  1. . D DT^DILF("",STDT,.PXNWSTDT) I PXNWSTDT=-1 W $C(7),"??",!," Invalid Date!" S %=1 G DT
  1. . S ^UTILITY($J,"PXCOMPACT")=DFN_"^"_PXNWSTDT_"^F"
  1. Q