AGNDXP ; IHS/ASDS/EFG - PRINT AN INDEX CARD-DFN REQUIRED ;
;;7.1;PATIENT REGISTRATION;**4,11**;AUG 25,2005;Build 1
;IHS/OIT/NKD AG*7.1*11 MU2 UNKNOWN SEX
;
S AGLN=0
G END:'$D(DFN),END:'$D(^DPT(DFN,0)),END:'$D(^AUPNPAT(DFN,41,DUZ(2),0))
D NMCH F AG("I")=1:1:17-AGLN W !
I '$D(AGALIAS) G END
S (AGLN,AG("ALNO"))=0
ALIASLP S AG("ALNO")=AG("ALNO")+1 G END:'$D(^DPT(DFN,.01,AG("ALNO"),0)),ALIASLP:$P(^DPT(DFN,.01,AG("ALNO"),0),U)=""
W $P(^DPT(DFN,.01,AG("ALNO"),0),U),"**ALIAS**",! S AGLN=AGLN+1
D NMCH F AG("I")=1:1:17-AGLN W !
S AGLN=0
G ALIASLP
NMCH S AGDPT=^DPT(DFN,0),AG41=^AUPNPAT(DFN,41,DUZ(2),0)
W $P(AGDPT,U),?45-$L($P(AG41,U,2)),$P(AG41,U,2) D LINE ;Line 1
S AGDOB="",Y=$P(AGDPT,U,3) I +Y D DD^%DT S AGDOB=Y
;IHS/OIT/NKD AG*7.1*11 MU2 - DISPLAY OF SEX TO INCLUDE UNKNOWN
;S A=$P(AGDPT,U,2),AGSEX=$S(A="M":"MALE",A="F":"FEMALE",1:" ")
S AGSEX=$$GET1^DIQ(2,DFN,.02),AGSEX=$S(AGSEX]"":AGSEX,1:" ")
;S A=$P(AGDPT,U,9) S:$L(A)=9 A=$E(A,1,3)_"-"_$E(A,4,5)_"-"_$E(A,6,99) S AGSSN=A
S AGSSN=$$GET1^DIQ(9000001,DFN_",",1107.3) ;IHS/SD/TPF AG*7.1*4
W AGDOB,?45-$L(AGSEX)\2,AGSEX,?45-$L(AGSSN),AGSSN D LINE ;Line 2
S (AGSTREET,AGADDR)="" I $D(^DPT(DFN,.11)) S A=^(.11),AGSTREET=$P(A,U) S:$P(A,U,4)]"" AGADDR=AGADDR_$P(A,U,4) I +$P(A,U,5),$D(^DIC(5,+$P(A,U,5),0)) S AGADDR=AGADDR_" "_$P(^(0),U,2)_" "_$P(A,U,6)
W AGSTREET I $D(^DPT(DFN,.13)),$P(^(.13),U)]"" S X="HOME PH: "_$P(^(.13),U) W ?45-$L(X),X ; Line 3
W !,AGADDR I $D(^DPT(DFN,.13)),$P(^(.13),U,2)]"" S X="OFFICE PH: "_$P(^(.13),U,2) W ?45-$L(X),X ; Line 4
D LINE
I $D(^DPT(DFN,.24)) W " FATHER: ",$P(^(.24),U),!,"MOTHER (MDN): ",$P(^(.24),U,3) S AGLN=AGLN+1 D LINE
S Y=DT D DD^%DT W "CARD PRINTED: ",Y G NMCHEND:$P(AG41,U,3)=""
I $P(AG41,U,3),+$P(AG41,U,4),$D(^AUTTDIS($P(AG41,U,4),0)) W !,"CHART ",$S($P(^(0),U)["ARCH":"ARCHIVED: ",1:"INACTIVATED: ") S Y=$P(AG41,U,3) D DD^%DT W Y S AGLN=AGLN+1
NMCHEND Q
END K A,AGADDR,AG41,AGDOB,AGDPT,AGSEX,AGSSN,AGSTREET,AGLN,X
Q
LINE W ! F AG("I")=1:1:45 W "-"
W !
S AGLN=AGLN+2
Q
ALIAS ;EP
W !!!,"Do you want to print index cards for ALIASES also? (Y/N) Y// " D READ^AG S Y=$E(Y_"Y") I $D(DQOUT) W !!,"An index card will be printed for the patients NAME and each ALIAS",!,"if you answer ""Y"" " G ALIAS
Q:$D(DTOUT)!$D(DFOUT)!$D(DUOUT) I "NY"'[Y D YN^AG G ALIAS
K AGALIAS I Y="Y" S AGALIAS=""
TEST W !!!,"DO YOU WANT TO PRINT A TEST LABEL? (Y/N) N// " D READ^AG S Y=$E(Y_"N") I $D(DQOUT) W !!,"A sample label will be printed so that you",!,"may allign your labels on the printer." G TEST
Q:(Y="N")!$D(DTOUT)!$D(DFOUT)!$D(DUOUT) I Y'="Y" D YN^AG G TEST
D ^%ZIS Q:POP U IO F I=1:1:3 W "TESTTESTTESTTESTTESTTESTTESTTESTTESTTESTTESTTESTXX",!
W !!!!!!!!!!!!!!! D ^%ZISC
G TEST
AGNDXP ; IHS/ASDS/EFG - PRINT AN INDEX CARD-DFN REQUIRED ;
+1 ;;7.1;PATIENT REGISTRATION;**4,11**;AUG 25,2005;Build 1
+2 ;IHS/OIT/NKD AG*7.1*11 MU2 UNKNOWN SEX
+3 ;
+4 SET AGLN=0
+5 IF '$DATA(DFN)
GOTO END
IF '$DATA(^DPT(DFN,0))
GOTO END
IF '$DATA(^AUPNPAT(DFN,41,DUZ(2),0))
GOTO END
+6 DO NMCH
FOR AG("I")=1:1:17-AGLN
WRITE !
+7 IF '$DATA(AGALIAS)
GOTO END
+8 SET (AGLN,AG("ALNO"))=0
ALIASLP SET AG("ALNO")=AG("ALNO")+1
IF '$DATA(^DPT(DFN,.01,AG("ALNO"),0))
GOTO END
IF $PIECE(^DPT(DFN,.01,AG("ALNO"),0),U)=""
GOTO ALIASLP
+1 WRITE $PIECE(^DPT(DFN,.01,AG("ALNO"),0),U),"**ALIAS**",!
SET AGLN=AGLN+1
+2 DO NMCH
FOR AG("I")=1:1:17-AGLN
WRITE !
+3 SET AGLN=0
+4 GOTO ALIASLP
NMCH SET AGDPT=^DPT(DFN,0)
SET AG41=^AUPNPAT(DFN,41,DUZ(2),0)
+1 ;Line 1
WRITE $PIECE(AGDPT,U),?45-$LENGTH($PIECE(AG41,U,2)),$PIECE(AG41,U,2)
DO LINE
+2 SET AGDOB=""
SET Y=$PIECE(AGDPT,U,3)
IF +Y
DO DD^%DT
SET AGDOB=Y
+3 ;IHS/OIT/NKD AG*7.1*11 MU2 - DISPLAY OF SEX TO INCLUDE UNKNOWN
+4 ;S A=$P(AGDPT,U,2),AGSEX=$S(A="M":"MALE",A="F":"FEMALE",1:" ")
+5 SET AGSEX=$$GET1^DIQ(2,DFN,.02)
SET AGSEX=$SELECT(AGSEX]"":AGSEX,1:" ")
+6 ;S A=$P(AGDPT,U,9) S:$L(A)=9 A=$E(A,1,3)_"-"_$E(A,4,5)_"-"_$E(A,6,99) S AGSSN=A
+7 ;IHS/SD/TPF AG*7.1*4
SET AGSSN=$$GET1^DIQ(9000001,DFN_",",1107.3)
+8 ;Line 2
WRITE AGDOB,?45-$LENGTH(AGSEX)\2,AGSEX,?45-$LENGTH(AGSSN),AGSSN
DO LINE
+9 SET (AGSTREET,AGADDR)=""
IF $DATA(^DPT(DFN,.11))
SET A=^(.11)
SET AGSTREET=$PIECE(A,U)
IF $PIECE(A,U,4)]""
SET AGADDR=AGADDR_$PIECE(A,U,4)
IF +$PIECE(A,U,5)
IF $DATA(^DIC(5,+$PIECE(A,U,5),0))
SET AGADDR=AGADDR_" "_$PIECE(^(0),U,2)_" "_$PIECE(A,U,6)
+10 ; Line 3
WRITE AGSTREET
IF $DATA(^DPT(DFN,.13))
IF $PIECE(^(.13),U)]""
SET X="HOME PH: "_$PIECE(^(.13),U)
WRITE ?45-$LENGTH(X),X
+11 ; Line 4
WRITE !,AGADDR
IF $DATA(^DPT(DFN,.13))
IF $PIECE(^(.13),U,2)]""
SET X="OFFICE PH: "_$PIECE(^(.13),U,2)
WRITE ?45-$LENGTH(X),X
+12 DO LINE
+13 IF $DATA(^DPT(DFN,.24))
WRITE " FATHER: ",$PIECE(^(.24),U),!,"MOTHER (MDN): ",$PIECE(^(.24),U,3)
SET AGLN=AGLN+1
DO LINE
+14 SET Y=DT
DO DD^%DT
WRITE "CARD PRINTED: ",Y
IF $PIECE(AG41,U,3)=""
GOTO NMCHEND
+15 IF $PIECE(AG41,U,3)
IF +$PIECE(AG41,U,4)
IF $DATA(^AUTTDIS($PIECE(AG41,U,4),0))
WRITE !,"CHART ",$SELECT($PIECE(^(0),U)["ARCH":"ARCHIVED: ",1:"INACTIVATED: ")
SET Y=$PIECE(AG41,U,3)
DO DD^%DT
WRITE Y
SET AGLN=AGLN+1
NMCHEND QUIT
END KILL A,AGADDR,AG41,AGDOB,AGDPT,AGSEX,AGSSN,AGSTREET,AGLN,X
+1 QUIT
LINE WRITE !
FOR AG("I")=1:1:45
WRITE "-"
+1 WRITE !
+2 SET AGLN=AGLN+2
+3 QUIT
ALIAS ;EP
+1 WRITE !!!,"Do you want to print index cards for ALIASES also? (Y/N) Y// "
DO READ^AG
SET Y=$EXTRACT(Y_"Y")
IF $DATA(DQOUT)
WRITE !!,"An index card will be printed for the patients NAME and each ALIAS",!,"if you answer ""Y"" "
GOTO ALIAS
+2 IF $DATA(DTOUT)!$DATA(DFOUT)!$DATA(DUOUT)
QUIT
IF "NY"'[Y
DO YN^AG
GOTO ALIAS
+3 KILL AGALIAS
IF Y="Y"
SET AGALIAS=""
TEST WRITE !!!,"DO YOU WANT TO PRINT A TEST LABEL? (Y/N) N// "
DO READ^AG
SET Y=$EXTRACT(Y_"N")
IF $DATA(DQOUT)
WRITE !!,"A sample label will be printed so that you",!,"may allign your labels on the printer."
GOTO TEST
+1 IF (Y="N")!$DATA(DTOUT)!$DATA(DFOUT)!$DATA(DUOUT)
QUIT
IF Y'="Y"
DO YN^AG
GOTO TEST
+2 DO ^%ZIS
IF POP
QUIT
USE IO
FOR I=1:1:3
WRITE "TESTTESTTESTTESTTESTTESTTESTTESTTESTTESTTESTTESTXX",!
+3 WRITE !!!!!!!!!!!!!!!
DO ^%ZISC
+4 GOTO TEST
