- ACHSDARR ; IHS/ITSC/PMF - PATIENT RELEASE OF INFORMATION FOR ALT RES ; [ 10/16/2001 8:16 AM ]
- ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
- ;
- ;'PARENT OR GUARDIAN (CHILD)'
- S ACHDNAME=$P($G(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,0)),U,4)
- G START:ACHDNAME'=""
- ;
- ;'IS PATIENT REGISTERED?'
- I $$DN^ACHS(0,6)="Y" S ACHDNAME=$P($G(^DPT($$DN^ACHS(0,7),0)),U) G START
- I $$DN^ACHS(0,6)="N" S ACHDNAME=$$DN^ACHS(10,1)
- ;
- START ;
- W @IOF,!!!!!!!!!!
- S ACHD=0
- F I=1:1:$L(ACHDNAME) S ACHD=$E(ACHDNAME,I) Q:ACHD="," G:ACHD="" START1
- S ACHDNAME=$P(ACHDNAME,",",2)_" "_$P(ACHDNAME,",")
- ;
- START1 ;
- S X=$P($G(^AUTNINS($P($G(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,0)),U),0)),U)
- S X="I, |_|"_ACHDNAME_"|_|, hereby authorize and request the |_|"_X_"|_| to release any and all information contained in my files to the Indian Health Service, Contract Health Services (CHS) Office."
- D ^DIWP
- S X="Information in the file should be forwarded to the following address: "
- D ^DIWP,^DIWW
- W !!!?DIWL+10,$$SUD^ACHS(1)
- I $L($$SUD^ACHS(7)) W !?DIWL+10,$$SUD^ACHS(7)
- ;
- W !?DIWL+10,$$SUD^ACHS(2),!?DIWL+10,$$SUD^ACHS(3),", ",$P($G(^DIC(5,$$SUD^ACHS(4),0)),U,2)," ",$$SUD^ACHS(5),!?DIWL+10,"Telephone: ",$$SUD^ACHS(6),!?DIWL+10,"ATTN: Contract Health",!!!
- S X="This information will aid the CHS Office in assisting and/or representing me in completing my application for alternate resources."
- D ^DIWP,^DIWW
- W !!!?DIWL+5,"Dated this ",$$DATE(DT,"DD",1)," day of ",$$DATE(DT,"MM",1),", ",$$DATE(DT,"YY"),"."
- W !!!!!?DIWL+30,"_________________________________",!!?DIWL+30,ACHDNAME
- END ;
- Q
- ;
- DATE(D,P,O) ;EP - "D" = Date, "P" = Part of Date, "O" = Option
- ; if Month or day.
- I '$G(D) Q -1
- I $L($G(P))'=2 Q -1
- I "MMDDYY"'[P Q -1
- S O=$G(O)
- S Y=$$FMTE^XLFDT(D)
- I P="YY" Q $P(Y," ",3)
- I P="MM" D Q Y
- . S Y=$P(Y," ",1)
- . Q:'O
- . S %=Y,Y=$S(%="Jan":"January",%="Feb":"February",%="Mar":"March",%="Apr":"April",%="May":%,%="Jun":"June",%="Jul":"July",%="Aug":"August",%="Sep":"September",%="Oct":"October",%="Nov":"November",1:"December")
- .Q
- S Y=$P(Y," ",2),Y=+$P(Y,",",1)
- Q:'O Y
- S %=Y,Y=Y_$S(%=1:"st",%=2:"nd",%=3:"rd",((%>3)&(%<21)):"th",%=21:"st",%=22:"nd",%=23:"rd",((%>23)&(%<31)):"th",1:"st")
- Q Y
- ;
- ACHSDARR ; IHS/ITSC/PMF - PATIENT RELEASE OF INFORMATION FOR ALT RES ; [ 10/16/2001 8:16 AM ]
- +1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
- +2 ;
- +3 ;'PARENT OR GUARDIAN (CHILD)'
- +4 SET ACHDNAME=$PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,0)),U,4)
- +5 IF ACHDNAME'=""
- GOTO START
- +6 ;
- +7 ;'IS PATIENT REGISTERED?'
- +8 IF $$DN^ACHS(0,6)="Y"
- SET ACHDNAME=$PIECE($GET(^DPT($$DN^ACHS(0,7),0)),U)
- GOTO START
- +9 IF $$DN^ACHS(0,6)="N"
- SET ACHDNAME=$$DN^ACHS(10,1)
- +10 ;
- START ;
- +1 WRITE @IOF,!!!!!!!!!!
- +2 SET ACHD=0
- +3 FOR I=1:1:$LENGTH(ACHDNAME)
- SET ACHD=$EXTRACT(ACHDNAME,I)
- IF ACHD=","
- QUIT
- IF ACHD=""
- GOTO START1
- +4 SET ACHDNAME=$PIECE(ACHDNAME,",",2)_" "_$PIECE(ACHDNAME,",")
- +5 ;
- START1 ;
- +1 SET X=$PIECE($GET(^AUTNINS($PIECE($GET(^ACHSDEN(DUZ(2),"D",ACHSA,800,ACHDALRS,0)),U),0)),U)
- +2 SET X="I, |_|"_ACHDNAME_"|_|, hereby authorize and request the |_|"_X_"|_| to release any and all information contained in my files to the Indian Health Service, Contract Health Services (CHS) Office."
- +3 DO ^DIWP
- +4 SET X="Information in the file should be forwarded to the following address: "
- +5 DO ^DIWP
- DO ^DIWW
- +6 WRITE !!!?DIWL+10,$$SUD^ACHS(1)
- +7 IF $LENGTH($$SUD^ACHS(7))
- WRITE !?DIWL+10,$$SUD^ACHS(7)
- +8 ;
- +9 WRITE !?DIWL+10,$$SUD^ACHS(2),!?DIWL+10,$$SUD^ACHS(3),", ",$PIECE($GET(^DIC(5,$$SUD^ACHS(4),0)),U,2)," ",$$SUD^ACHS(5),!?DIWL+10,"Telephone: ",$$SUD^ACHS(6),!?DIWL+10,"ATTN: Contract Health",!!!
- +10 SET X="This information will aid the CHS Office in assisting and/or representing me in completing my application for alternate resources."
- +11 DO ^DIWP
- DO ^DIWW
- +12 WRITE !!!?DIWL+5,"Dated this ",$$DATE(DT,"DD",1)," day of ",$$DATE(DT,"MM",1),", ",$$DATE(DT,"YY"),"."
- +13 WRITE !!!!!?DIWL+30,"_________________________________",!!?DIWL+30,ACHDNAME
- END ;
- +1 QUIT
- +2 ;
- DATE(D,P,O) ;EP - "D" = Date, "P" = Part of Date, "O" = Option
- +1 ; if Month or day.
- +2 IF '$GET(D)
- QUIT -1
- +3 IF $LENGTH($GET(P))'=2
- QUIT -1
- +4 IF "MMDDYY"'[P
- QUIT -1
- +5 SET O=$GET(O)
- +6 SET Y=$$FMTE^XLFDT(D)
- +7 IF P="YY"
- QUIT $PIECE(Y," ",3)
- +8 IF P="MM"
- Begin DoDot:1
- +9 SET Y=$PIECE(Y," ",1)
- +10 IF 'O
- QUIT
- +11 SET %=Y
- SET Y=$SELECT(%="Jan":"January",%="Feb":"February",%="Mar":"March",%="Apr":"April",%="May":%,%="Jun":"June",%="Jul":"July",%="Aug":"August",%="Sep":"September",%="Oct":"October",%="Nov":"November",1:"December")
- +12 QUIT
- End DoDot:1
- QUIT Y
- +13 SET Y=$PIECE(Y," ",2)
- SET Y=+$PIECE(Y,",",1)
- +14 IF 'O
- QUIT Y
- +15 SET %=Y
- SET Y=Y_$SELECT(%=1:"st",%=2:"nd",%=3:"rd",((%>3)&(%<21)):"th",%=21:"st",%=22:"nd",%=23:"rd",((%>23)&(%<31)):"th",1:"st")
- +16 QUIT Y
- +17 ;
