AGSSPRT ; IHS/ASDS/EFG - SSN VERIFICATION FROM NPIRS/SSA ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
K DUOUT,DFOUT,DIRUT,DTOUT
LOOP ;
S AGSDFN=0 F S AGSDFN=$O(^AGSSTEMP(AGSSITE,AGSGLO,AGSDFN)) Q:'AGSDFN Q:($G(DUOUT)!$G(DFOUT)!$G(DURUT)!$G(DTOUT)) S AGSCREC=^AGSSTEMP(AGSSITE,AGSGLO,AGSDFN) D PRINT
Q
PRINT ;
U IO D AGSSPG Q:($G(DIRUT)!$G(DUOUT)!$G(DFOUT)!$G(DTOUT))
D LVAR,PATL ;Print the info from Local database
I AGSCREC]"" D
.D CVAR,PATC ;Print the info from NPIRS
E D ;else
.W !! ;Allow for no record printed
Q
VARS ;
CVARS ;
CVAR ;
S AGSUFAC=$P(AGSCREC,U)
S AGSHRN=+$P(AGSCREC,U,2)
S AGSCSSN1=+$P(AGSCREC,U,3)
S AGSCLN=$P(AGSCREC,U,4)
S AGSCFN=$P(AGSCREC,U,5)
S AGSCMN=$P(AGSCREC,U,6)
S AGSCDOB=$P(AGSCREC,U,7)-17000000
S AGSCSX=$P(AGSCREC,U,8)
S AGSCVC=$P(AGSCREC,U,9)
S AGSCSSN2=+$P(AGSCREC,U,10)
F AGSX="AGSCLN","AGSCFN","AGSCMN" S AGSY=$L(@AGSX) I AGSY F AGSI=AGSY:-1:0 Q:$E(@AGSX,AGSI)]" " S @AGSX=$E(@AGSX,0,AGSI-1)
S AGSCNM=AGSCLN_","_AGSCFN
S:AGSCVC="V" AGSCSSN2=AGSCSSN1
ECVAR Q
LVAR ;
S AG0=^DPT(AGSDFN,0),AGSHRN=$G(^AUPNPAT(AGSDFN,41,AGSSITE,0)),AGSHRN=$P(AGSHRN,U,2)
S AGSLNM=$P(AG0,U),AGSLSSN=$P(AG0,U,9),AGSLSX=$P(AG0,U,2)
S AGSLDOB=$P(AG0,U,3)
ELVAR Q
PATL ;
U IO W !,AGSHRN,?8,AGSLNM,?35,"L: ",AGSLSSN,?49,"I: ",$J(AGSDFN,9),?64,AGSLVC,?66,AGSLSX,?68,$$MDT(AGSLDOB)
Q
PATC ;
W !,AGSHRN,?8,AGSCNM,?35,"S: ",AGSCSSN2,?49,"D: ",$J(AGSCSSN1,9),?64,AGSCVC,?66,AGSCSX,?68,$$MDT(AGSCDOB),!
Q
LAST ;
AGSSPG ;EP - page controller
Q:($Y<(IOSL-4))!($G(DOUT)!$G(DFOUT))
S AGSSPG=$G(AGSSPG)+1
I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR
Q:($G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DROUT))
D AGSSHDR,AGSSHD
Q
AGSSHDR ;EP - write page header
W:$Y @IOF W ! Q:'$D(AGSSHDR) S:'$D(AGSSLINE) $P(AGSSLINE,"-",IOM-2)="" S:'$D(AGSSPG) AGSSPG=1 I '$D(AGSSDT) S %H=$H D YX^%DTC S AGSSDT=Y
U IO W ?(IOM-40-$L(AGSSHDR)/2),AGSSHDR,?(IOM-40),AGSSDT,?(IOM-10),"PAGE: ",AGSSPG,!,AGSSLINE
Q
AGSSHD ;EP - write column header / message
I AGSSPG=1 W !,?3,"Local Data",!,?5,"HRN",?10,"Name ",?20,"L: Local SSN",?44,"I: Internal Entry Number for patient"
I AGSSPG=1,"RD,RN,RP"[AGSGLO W !,?3,"NPIRS Data",!,?5,"HRN",?10,"Name ",?20,"S: Social Security SSN ",?44,"D: IHS NPIRS SSN",!,?5,"Codes: V-Verified A-Only one on file *-1 digit differs",!
W !,"HRN",?8,"Name",?35,"SSNs",?60,"Code",?65,"Sex",?70,"DOB"
Q:($G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DROUT))
EAGSSPG Q
MDT(X) ;EP - date format dd mmm yyyy
I X="" Q X
S X=+$E(X,6,7)_" "_$P($T(MTHS+1),";;",+$E(X,4,5)+1)_" "_($E(X,1,3)+1700)
S X=$J(X,12)
Q X
MTHS ;months
;;JAN;;FEB;;MAR;;APR;;MAY;;JUN;;JUL;;AUG;;SEP;;OCT;;NOV;;DEC
AGSSPRT ; IHS/ASDS/EFG - SSN VERIFICATION FROM NPIRS/SSA ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
+3 KILL DUOUT,DFOUT,DIRUT,DTOUT
LOOP ;
+1 SET AGSDFN=0
FOR
SET AGSDFN=$ORDER(^AGSSTEMP(AGSSITE,AGSGLO,AGSDFN))
IF 'AGSDFN
QUIT
IF ($GET(DUOUT)!$GET(DFOUT)!$GET(DURUT)!$GET(DTOUT))
QUIT
SET AGSCREC=^AGSSTEMP(AGSSITE,AGSGLO,AGSDFN)
DO PRINT
+2 QUIT
PRINT ;
+1 USE IO
DO AGSSPG
IF ($GET(DIRUT)!$GET(DUOUT)!$GET(DFOUT)!$GET(DTOUT))
QUIT
+2 ;Print the info from Local database
DO LVAR
DO PATL
+3 IF AGSCREC]""
Begin DoDot:1
+4 ;Print the info from NPIRS
DO CVAR
DO PATC
End DoDot:1
+5 ;else
IF '$TEST
Begin DoDot:1
+6 ;Allow for no record printed
WRITE !!
End DoDot:1
+7 QUIT
VARS ;
CVARS ;
CVAR ;
+1 SET AGSUFAC=$PIECE(AGSCREC,U)
+2 SET AGSHRN=+$PIECE(AGSCREC,U,2)
+3 SET AGSCSSN1=+$PIECE(AGSCREC,U,3)
+4 SET AGSCLN=$PIECE(AGSCREC,U,4)
+5 SET AGSCFN=$PIECE(AGSCREC,U,5)
+6 SET AGSCMN=$PIECE(AGSCREC,U,6)
+7 SET AGSCDOB=$PIECE(AGSCREC,U,7)-17000000
+8 SET AGSCSX=$PIECE(AGSCREC,U,8)
+9 SET AGSCVC=$PIECE(AGSCREC,U,9)
+10 SET AGSCSSN2=+$PIECE(AGSCREC,U,10)
+11 FOR AGSX="AGSCLN","AGSCFN","AGSCMN"
SET AGSY=$LENGTH(@AGSX)
IF AGSY
FOR AGSI=AGSY:-1:0
IF $EXTRACT(@AGSX,AGSI)]" "
QUIT
SET @AGSX=$EXTRACT(@AGSX,0,AGSI-1)
+12 SET AGSCNM=AGSCLN_","_AGSCFN
+13 IF AGSCVC="V"
SET AGSCSSN2=AGSCSSN1
ECVAR QUIT
LVAR ;
+1 SET AG0=^DPT(AGSDFN,0)
SET AGSHRN=$GET(^AUPNPAT(AGSDFN,41,AGSSITE,0))
SET AGSHRN=$PIECE(AGSHRN,U,2)
+2 SET AGSLNM=$PIECE(AG0,U)
SET AGSLSSN=$PIECE(AG0,U,9)
SET AGSLSX=$PIECE(AG0,U,2)
+3 SET AGSLDOB=$PIECE(AG0,U,3)
ELVAR QUIT
PATL ;
+1 USE IO
WRITE !,AGSHRN,?8,AGSLNM,?35,"L: ",AGSLSSN,?49,"I: ",$JUSTIFY(AGSDFN,9),?64,AGSLVC,?66,AGSLSX,?68,$$MDT(AGSLDOB)
+2 QUIT
PATC ;
+1 WRITE !,AGSHRN,?8,AGSCNM,?35,"S: ",AGSCSSN2,?49,"D: ",$JUSTIFY(AGSCSSN1,9),?64,AGSCVC,?66,AGSCSX,?68,$$MDT(AGSCDOB),!
+2 QUIT
LAST ;
AGSSPG ;EP - page controller
+1 IF ($Y<(IOSL-4))!($GET(DOUT)!$GET(DFOUT))
QUIT
+2 SET AGSSPG=$GET(AGSSPG)+1
+3 IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
+4 IF ($GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT)!$GET(DROUT))
QUIT
+5 DO AGSSHDR
DO AGSSHD
+6 QUIT
AGSSHDR ;EP - write page header
+1 IF $Y
WRITE @IOF
WRITE !
IF '$DATA(AGSSHDR)
QUIT
IF '$DATA(AGSSLINE)
SET $PIECE(AGSSLINE,"-",IOM-2)=""
IF '$DATA(AGSSPG)
SET AGSSPG=1
IF '$DATA(AGSSDT)
SET %H=$HOROLOG
DO YX^%DTC
SET AGSSDT=Y
+2 USE IO
WRITE ?(IOM-40-$LENGTH(AGSSHDR)/2),AGSSHDR,?(IOM-40),AGSSDT,?(IOM-10),"PAGE: ",AGSSPG,!,AGSSLINE
+3 QUIT
AGSSHD ;EP - write column header / message
+1 IF AGSSPG=1
WRITE !,?3,"Local Data",!,?5,"HRN",?10,"Name ",?20,"L: Local SSN",?44,"I: Internal Entry Number for patient"
+2 IF AGSSPG=1
IF "RD,RN,RP"[AGSGLO
WRITE !,?3,"NPIRS Data",!,?5,"HRN",?10,"Name ",?20,"S: Social Security SSN ",?44,"D: IHS NPIRS SSN",!,?5,"Codes: V-Verified A-Only one on file *-1 digit differs",!
+3 WRITE !,"HRN",?8,"Name",?35,"SSNs",?60,"Code",?65,"Sex",?70,"DOB"
+4 IF ($GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT)!$GET(DROUT))
QUIT
EAGSSPG QUIT
MDT(X) ;EP - date format dd mmm yyyy
+1 IF X=""
QUIT X
+2 SET X=+$EXTRACT(X,6,7)_" "_$PIECE($TEXT(MTHS+1),";;",+$EXTRACT(X,4,5)+1)_" "_($EXTRACT(X,1,3)+1700)
+3 SET X=$JUSTIFY(X,12)
+4 QUIT X
MTHS ;months
+1 ;;JAN;;FEB;;MAR;;APR;;MAY;;JUN;;JUL;;AUG;;SEP;;OCT;;NOV;;DEC
