GMTSDEMC ;SLC/JLC - Sexual Orientation Data ;Jun 07, 2023@11:36
;;2.7;Health Summary;**141,144**;Oct 20, 1995;Build 17
;
;
SEXOR ; Sexual Orientation
N I,VAPTYP,VAHOW,VACOM,VADM,VA,VAERR,S1,TMP,GMTSNPG
D DEM^VADPT
D CKP^GMTSUP Q:$D(GMTSQIT)
W "The sexual orientation information below shows all active entries listed by the",!
D CKP^GMTSUP Q:$D(GMTSQIT)
W "date they were updated.",!!
W "------------------------------------------------------------------------------",!!
I '$D(VADM(14,1)) G SEXORN
F I=1:1:VADM(14,1) D
. I $P(VADM(14,1,I,1),"^",2)'="A" Q
. S TMP($P(VADM(14,1,I,3),"^"),I)=""
I '$D(TMP) G SEXORN
S S1=""
F S S1=$O(TMP(S1)) Q:S1="" D
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W S1,":",!
. S I=0 F S I=$O(TMP(S1,I)) Q:'I D
.. W ?5,$P(VADM(14,1,I),"^"),!
.. I $P(VADM(14,1,I),U,2)="OTH" W ?8,$G(VADM(14,2)),!
. W !
Q
SEXORN ;NO ACTIVE ENTRIES
W "No active sexual orientation defined."
Q
PRONOUN ;Pronouns
N VAPTYP,VAHOW,VACOM,VADM,VA,VAERR,GMTSFIRST,GMTSNUM,GMTSNPG,GMTSTEXT
D DEM^VADPT
D CKP^GMTSUP Q:$D(GMTSQIT)
W !,"Pronoun(s): "
I $D(VADM(14,3))>9 D
.S GMTSFIRST=1,GMTSNUM=0 F S GMTSNUM=$O(VADM(14,3,GMTSNUM)) Q:'+GMTSNUM D
..I GMTSFIRST=1 S GMTSFIRST=0
..E D
...D CKP^GMTSUP Q:$D(GMTSQIT)
...W !
...I GMTSNPG W "Pronoun(s): "
..Q:$D(GMTSQIT)
..W ?10,$P($G(VADM(14,3,GMTSNUM)),U,1)
.I $G(VADM(14,4))'="" D FORMAT^GMTSU(VADM(14,4),"Pronoun Open Text",1),LINE^GMTSU
I $D(VADM(14,3))<10 W "<Not Provided>"
D CKP^GMTSUP Q:$D(GMTSQIT)
W !
Q
SIGI ;Self-Identified Gender
N VAPTYP,VAHOW,VACOM,VADM,VA,VAERR,GMTSNPG,GMTSTEXT
D DEM^VADPT
D CKP^GMTSUP Q:$D(GMTSQIT)
S GMTSTEXT=$P($G(VADM(14,5)),U,1)
I GMTSTEXT="" S GMTSTEXT="<Not Provided>"
W !,"Gender Identity: ",GMTSTEXT
D CKP^GMTSUP Q:$D(GMTSQIT)
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSDEMC 1860 printed Dec 13, 2024@01:57:17 Page 2
GMTSDEMC ;SLC/JLC - Sexual Orientation Data ;Jun 07, 2023@11:36
+1 ;;2.7;Health Summary;**141,144**;Oct 20, 1995;Build 17
+2 ;
+3 ;
SEXOR ; Sexual Orientation
+1 NEW I,VAPTYP,VAHOW,VACOM,VADM,VA,VAERR,S1,TMP,GMTSNPG
+2 DO DEM^VADPT
+3 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+4 WRITE "The sexual orientation information below shows all active entries listed by the",!
+5 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+6 WRITE "date they were updated.",!!
+7 WRITE "------------------------------------------------------------------------------",!!
+8 IF '$DATA(VADM(14,1))
GOTO SEXORN
+9 FOR I=1:1:VADM(14,1)
Begin DoDot:1
+10 IF $PIECE(VADM(14,1,I,1),"^",2)'="A"
QUIT
+11 SET TMP($PIECE(VADM(14,1,I,3),"^"),I)=""
End DoDot:1
+12 IF '$DATA(TMP)
GOTO SEXORN
+13 SET S1=""
+14 FOR
SET S1=$ORDER(TMP(S1))
if S1=""
QUIT
Begin DoDot:1
+15 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+16 WRITE S1,":",!
+17 SET I=0
FOR
SET I=$ORDER(TMP(S1,I))
if 'I
QUIT
Begin DoDot:2
+18 WRITE ?5,$PIECE(VADM(14,1,I),"^"),!
+19 IF $PIECE(VADM(14,1,I),U,2)="OTH"
WRITE ?8,$GET(VADM(14,2)),!
End DoDot:2
+20 WRITE !
End DoDot:1
+21 QUIT
SEXORN ;NO ACTIVE ENTRIES
+1 WRITE "No active sexual orientation defined."
+2 QUIT
PRONOUN ;Pronouns
+1 NEW VAPTYP,VAHOW,VACOM,VADM,VA,VAERR,GMTSFIRST,GMTSNUM,GMTSNPG,GMTSTEXT
+2 DO DEM^VADPT
+3 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+4 WRITE !,"Pronoun(s): "
+5 IF $DATA(VADM(14,3))>9
Begin DoDot:1
+6 SET GMTSFIRST=1
SET GMTSNUM=0
FOR
SET GMTSNUM=$ORDER(VADM(14,3,GMTSNUM))
if '+GMTSNUM
QUIT
Begin DoDot:2
+7 IF GMTSFIRST=1
SET GMTSFIRST=0
+8 IF '$TEST
Begin DoDot:3
+9 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+10 WRITE !
+11 IF GMTSNPG
WRITE "Pronoun(s): "
End DoDot:3
+12 if $DATA(GMTSQIT)
QUIT
+13 WRITE ?10,$PIECE($GET(VADM(14,3,GMTSNUM)),U,1)
End DoDot:2
+14 IF $GET(VADM(14,4))'=""
DO FORMAT^GMTSU(VADM(14,4),"Pronoun Open Text",1)
DO LINE^GMTSU
End DoDot:1
+15 IF $DATA(VADM(14,3))<10
WRITE "<Not Provided>"
+16 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+17 WRITE !
+18 QUIT
SIGI ;Self-Identified Gender
+1 NEW VAPTYP,VAHOW,VACOM,VADM,VA,VAERR,GMTSNPG,GMTSTEXT
+2 DO DEM^VADPT
+3 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+4 SET GMTSTEXT=$PIECE($GET(VADM(14,5)),U,1)
+5 IF GMTSTEXT=""
SET GMTSTEXT="<Not Provided>"
+6 WRITE !,"Gender Identity: ",GMTSTEXT
+7 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+8 WRITE !
+9 QUIT
