PXRMDG ;SLC/AGP - Clincial Reminders Updates to DG ;Oct 06, 2022@14:58:56
;;2.0;CLINICAL REMINDERS;**78,83**;Feb 4, 2005;Build 14
;
;DBIA USED
;7323 $$SOGI^VAFCAPI
;10061 DEM^VADPT
;main entry point for updating DG data
EN(RESULT,INPUTS) ;
N DFN,NOTE,VISIT
S DFN=+$G(INPUTS("DFN")) I DFN=0 S RESULT(1)="-1^No DFN"
S NOTE=+$G(INPUTS("DOCUMENT")) I NOTE=0 S RESULT(0)="-1^No Note passed in"
I $D(INPUTS("DATA",2.025)) D SEXORUP(.RESULT,.INPUTS,DFN,NOTE)
Q
;
;build array to send DG package to update Sexual Orientation
BLDSEXOR(RESULTS,INPUTS,DFN,NOTE) ;
N ARRAY,CNT,DESC,ID,TCNT,VALUE
D BLDEXSEX(DFN,.ARRAY)
S ID="" F S ID=$O(INPUTS("DATA",2.025,ID)) Q:ID="" D
.S CNT=0
.S VALUE=$G(INPUTS("DATA",2.025,ID,.01)) I VALUE="" Q
.I '$D(ARRAY("INDEXES")) S CNT=+ID
.I CNT=0,$D(ARRAY(VALUE)) S CNT=+ARRAY(VALUE) K ARRAY(VALUE)
.I CNT=0,$D(ARRAY("INDEXES",+ID)) D
..S TCNT=+$O(ARRAY("INDEXES",""),-1)+1
..I $D(RESULTS("SexOr",TCNT)) S TCNT=+$O(RESULTS("SexOr",""),-1)+1
..S CNT=TCNT
.S RESULTS("SexOr",CNT)=VALUE_U_"A"_U_NOTE
I $D(INPUTS("DATA",2)) D
.S DESC=""
.S ID="" F S ID=$O(INPUTS("DATA",2,ID)) Q:ID=""!(DESC'="") D
..S DESC=$G(INPUTS("DATA",2,ID,.0251))
.I DESC'="" S RESULTS("SexOrDes")=DESC
S VALUE="" F S VALUE=$O(ARRAY(VALUE)) Q:VALUE="" D
.I $G(ARRAY(VALUE))="" Q
.S ID=$P(ARRAY(VALUE),U)
.I $P(ARRAY(VALUE),U,2)="I" S RESULTS("SexOr",ID)=VALUE_U_$P(ARRAY(VALUE),U,2,3) Q
.I $P(ARRAY(VALUE),U,2)="E" S RESULTS("SexOr",ID)=VALUE_U_$P(ARRAY(VALUE),U,2,3) Q
.S RESULTS("SexOr",ID)=VALUE_U_"I"_U_NOTE
Q
;
;collect Sexual Orientations already on file
BLDEXSEX(DFN,RESULTS) ;
N IDX,TEMP,TYP,VADM
D DEM^VADPT
S IDX=0 F S IDX=$O(VADM(14,1,IDX)) Q:IDX'>0 D
.S TEMP=IDX_U_$P($G(VADM(14,1,IDX,1)),U,2)_U_$P($G(VADM(14,1,IDX,4)),U,2)_U_$P($G(VADM(14,1,IDX,2)),U,2)_U_$P($G(VADM(14,1,IDX,3)),U,2)
.S RESULTS($P(VADM(14,1,IDX),U,2))=TEMP
.S RESULTS("INDEXES",IDX)=""
Q
;
NOTEACT(PXRMDOCINFO) ;
N DFN,IDX,NOTEIEN,NOTENAME,PXRMARR,PXRMINPUTS,TEMP,TMPARR,VALUE
I '$D(PXRMDOCINFO("OLD")) Q
S DFN=+$G(PXRMDOCINFO("OLD","DFN")) I DFN=0 Q
S NOTEIEN=+$G(PXRMDOCINFO("OLD","NOTE IEN")) I NOTEIEN=0 Q
S PXRMINPUTS("Note")=NOTEIEN
S TEMP=$$SOGI^VAFCAPI(DFN,.PXRMINPUTS,1)
Q
;
;call to update/add Sexual Orientation on file
SEXORUP(RESULT,INPUTS,DFN,NOTE) ;
N PXRMARR,TEMP
D BLDSEXOR(.PXRMARR,.INPUTS,DFN,NOTE)
S TEMP=$$SOGI^VAFCAPI(DFN,.PXRMARR,1)
S RESULT(1)=$S(+$P(TEMP,U)=-1:TEMP,1:1)
Q
;
;call to verified Sexual Orientation updates coming in from the GUI
VERDATA(RESULTS,INPUTS) ;
N DFN,PXRMARR,TEMP
S RESULTS(0)=1
S DFN=+$G(INPUTS("DFN")) I DFN=0 S RESULTS(1)="-1^No DFN"
D BLDSEXOR(.PXRMARR,.INPUTS,DFN,"")
S TEMP=$$SOGI^VAFCAPI(DFN,.PXRMARR)
I +$P(TEMP,U)=-1 S RESULTS(0)=-1,RESULTS(1)=$P(TEMP,U,2)
Q
;
;call to return data that was entered via a notes in CPRS
GETFINDS(SUB,DFN,VISIT,NOTE) ;
N CNT,ERROR,FIELD,FILE,IDX,PKG,X1,X4,VADM
S PKG=+$$FIND1^DIC(9.4,,,"REGISTRATION",,"I $P($G(^(0)),U,2)=""DG""","ERROR")
I $D(ERROR) Q
S FIELD=.01,FILE=2.025
D DEM^VADPT
S IDX=0,CNT=0 F S IDX=$O(VADM(14,1,IDX)) Q:IDX'>0 D
.S X4=$G(VADM(14,1,IDX,4)) I $P(X4,U,2)'=NOTE Q
.S X1=$G(VADM(14,1,IDX))
.S ^TMP(SUB,$J,PKG,FILE,FIELD,IDX)=$P(X1,U),CNT=CNT+1
S ^TMP(SUB,$J)=CNT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDG 3341 printed Dec 13, 2024@01:43:42 Page 2
PXRMDG ;SLC/AGP - Clincial Reminders Updates to DG ;Oct 06, 2022@14:58:56
+1 ;;2.0;CLINICAL REMINDERS;**78,83**;Feb 4, 2005;Build 14
+2 ;
+3 ;DBIA USED
+4 ;7323 $$SOGI^VAFCAPI
+5 ;10061 DEM^VADPT
+6 ;main entry point for updating DG data
EN(RESULT,INPUTS) ;
+1 NEW DFN,NOTE,VISIT
+2 SET DFN=+$GET(INPUTS("DFN"))
IF DFN=0
SET RESULT(1)="-1^No DFN"
+3 SET NOTE=+$GET(INPUTS("DOCUMENT"))
IF NOTE=0
SET RESULT(0)="-1^No Note passed in"
+4 IF $DATA(INPUTS("DATA",2.025))
DO SEXORUP(.RESULT,.INPUTS,DFN,NOTE)
+5 QUIT
+6 ;
+7 ;build array to send DG package to update Sexual Orientation
BLDSEXOR(RESULTS,INPUTS,DFN,NOTE) ;
+1 NEW ARRAY,CNT,DESC,ID,TCNT,VALUE
+2 DO BLDEXSEX(DFN,.ARRAY)
+3 SET ID=""
FOR
SET ID=$ORDER(INPUTS("DATA",2.025,ID))
if ID=""
QUIT
Begin DoDot:1
+4 SET CNT=0
+5 SET VALUE=$GET(INPUTS("DATA",2.025,ID,.01))
IF VALUE=""
QUIT
+6 IF '$DATA(ARRAY("INDEXES"))
SET CNT=+ID
+7 IF CNT=0
IF $DATA(ARRAY(VALUE))
SET CNT=+ARRAY(VALUE)
KILL ARRAY(VALUE)
+8 IF CNT=0
IF $DATA(ARRAY("INDEXES",+ID))
Begin DoDot:2
+9 SET TCNT=+$ORDER(ARRAY("INDEXES",""),-1)+1
+10 IF $DATA(RESULTS("SexOr",TCNT))
SET TCNT=+$ORDER(RESULTS("SexOr",""),-1)+1
+11 SET CNT=TCNT
End DoDot:2
+12 SET RESULTS("SexOr",CNT)=VALUE_U_"A"_U_NOTE
End DoDot:1
+13 IF $DATA(INPUTS("DATA",2))
Begin DoDot:1
+14 SET DESC=""
+15 SET ID=""
FOR
SET ID=$ORDER(INPUTS("DATA",2,ID))
if ID=""!(DESC'="")
QUIT
Begin DoDot:2
+16 SET DESC=$GET(INPUTS("DATA",2,ID,.0251))
End DoDot:2
+17 IF DESC'=""
SET RESULTS("SexOrDes")=DESC
End DoDot:1
+18 SET VALUE=""
FOR
SET VALUE=$ORDER(ARRAY(VALUE))
if VALUE=""
QUIT
Begin DoDot:1
+19 IF $GET(ARRAY(VALUE))=""
QUIT
+20 SET ID=$PIECE(ARRAY(VALUE),U)
+21 IF $PIECE(ARRAY(VALUE),U,2)="I"
SET RESULTS("SexOr",ID)=VALUE_U_$PIECE(ARRAY(VALUE),U,2,3)
QUIT
+22 IF $PIECE(ARRAY(VALUE),U,2)="E"
SET RESULTS("SexOr",ID)=VALUE_U_$PIECE(ARRAY(VALUE),U,2,3)
QUIT
+23 SET RESULTS("SexOr",ID)=VALUE_U_"I"_U_NOTE
End DoDot:1
+24 QUIT
+25 ;
+26 ;collect Sexual Orientations already on file
BLDEXSEX(DFN,RESULTS) ;
+1 NEW IDX,TEMP,TYP,VADM
+2 DO DEM^VADPT
+3 SET IDX=0
FOR
SET IDX=$ORDER(VADM(14,1,IDX))
if IDX'>0
QUIT
Begin DoDot:1
+4 SET TEMP=IDX_U_$PIECE($GET(VADM(14,1,IDX,1)),U,2)_U_$PIECE($GET(VADM(14,1,IDX,4)),U,2)_U_$PIECE($GET(VADM(14,1,IDX,2)),U,2)_U_$PIECE($GET(VADM(14,1,IDX,3)),U,2)
+5 SET RESULTS($PIECE(VADM(14,1,IDX),U,2))=TEMP
+6 SET RESULTS("INDEXES",IDX)=""
End DoDot:1
+7 QUIT
+8 ;
NOTEACT(PXRMDOCINFO) ;
+1 NEW DFN,IDX,NOTEIEN,NOTENAME,PXRMARR,PXRMINPUTS,TEMP,TMPARR,VALUE
+2 IF '$DATA(PXRMDOCINFO("OLD"))
QUIT
+3 SET DFN=+$GET(PXRMDOCINFO("OLD","DFN"))
IF DFN=0
QUIT
+4 SET NOTEIEN=+$GET(PXRMDOCINFO("OLD","NOTE IEN"))
IF NOTEIEN=0
QUIT
+5 SET PXRMINPUTS("Note")=NOTEIEN
+6 SET TEMP=$$SOGI^VAFCAPI(DFN,.PXRMINPUTS,1)
+7 QUIT
+8 ;
+9 ;call to update/add Sexual Orientation on file
SEXORUP(RESULT,INPUTS,DFN,NOTE) ;
+1 NEW PXRMARR,TEMP
+2 DO BLDSEXOR(.PXRMARR,.INPUTS,DFN,NOTE)
+3 SET TEMP=$$SOGI^VAFCAPI(DFN,.PXRMARR,1)
+4 SET RESULT(1)=$SELECT(+$PIECE(TEMP,U)=-1:TEMP,1:1)
+5 QUIT
+6 ;
+7 ;call to verified Sexual Orientation updates coming in from the GUI
VERDATA(RESULTS,INPUTS) ;
+1 NEW DFN,PXRMARR,TEMP
+2 SET RESULTS(0)=1
+3 SET DFN=+$GET(INPUTS("DFN"))
IF DFN=0
SET RESULTS(1)="-1^No DFN"
+4 DO BLDSEXOR(.PXRMARR,.INPUTS,DFN,"")
+5 SET TEMP=$$SOGI^VAFCAPI(DFN,.PXRMARR)
+6 IF +$PIECE(TEMP,U)=-1
SET RESULTS(0)=-1
SET RESULTS(1)=$PIECE(TEMP,U,2)
+7 QUIT
+8 ;
+9 ;call to return data that was entered via a notes in CPRS
GETFINDS(SUB,DFN,VISIT,NOTE) ;
+1 NEW CNT,ERROR,FIELD,FILE,IDX,PKG,X1,X4,VADM
+2 SET PKG=+$$FIND1^DIC(9.4,,,"REGISTRATION",,"I $P($G(^(0)),U,2)=""DG""","ERROR")
+3 IF $DATA(ERROR)
QUIT
+4 SET FIELD=.01
SET FILE=2.025
+5 DO DEM^VADPT
+6 SET IDX=0
SET CNT=0
FOR
SET IDX=$ORDER(VADM(14,1,IDX))
if IDX'>0
QUIT
Begin DoDot:1
+7 SET X4=$GET(VADM(14,1,IDX,4))
IF $PIECE(X4,U,2)'=NOTE
QUIT
+8 SET X1=$GET(VADM(14,1,IDX))
+9 SET ^TMP(SUB,$JOB,PKG,FILE,FIELD,IDX)=$PIECE(X1,U)
SET CNT=CNT+1
End DoDot:1
+10 SET ^TMP(SUB,$JOB)=CNT
+11 QUIT
+12 ;
