- GMTSSOWZ ;SLC/SBW - Social Work extract comp. in HS namespace ;21/OCT/94
- ;;2.7;Health Summary;;Oct 20, 1995
- SOWKHSUM ; B'ham ISC/DMA - health summary ; 19 Jul 94 / 8:30 AM
- ;;3.0; Social Work ;;27 Apr 93
- ;;
- ;Called with DFN - assumed to be valid
- ;returns parts V. VII. and VIII. of the assessment
- ;in ^TMP("SOWK",$J,line number)
- ;
- N LINE,SP15,MS,SP,J,C,Y,X,SO,SP10,SZ,D,DIWL,DIWF
- K ^TMP("SOWK",$J) Q:'$D(^SOWK(655.2,DFN,0)) S LINE=6,$P(SP15," ",15)="",SP10=$E(SP15,1,10)
- S MS=$P($G(^DIC(11,+$P(^DPT(DFN,0),"^",5),0)),"^")
- S ^TMP("SOWK",$J,1)="Source of Referral: "_$P(^SOWK(655.2,DFN,0),"^",21)
- S ^TMP("SOWK",$J,2)="Source of Information: "_$S($D(^SOWK(655.2,DFN,18)):$P(^(18),"^"),1:"UNSPECIFIED")
- S ^TMP("SOWK",$J,3)="Social/Family Relationship:",^(4)=" 1. Marital status: "_MS,^(5)=" 2. Spouse:"
- S SP=$G(^SOWK(655.2,DFN,6))
- F J=1:1:4 I $P(SP,"^",J)]"" S ^TMP("SOWK",$J,LINE)=SP15_$P(SP,"^",J),LINE=LINE+1
- I $P(SP,"^",5)]"" S SZ=$P(^DIC(5,+$P(SP,"^",5),0),"^")_" "_$P(SP,"^",6),^(LINE-1)=^TMP("SOWK",$J,LINE-1)_", "_SZ
- S ^TMP("SOWK",$J,LINE)=" 3. Children:",LINE=LINE+1
- F J=0:0 S J=$O(^SOWK(655.2,DFN,7,J)) Q:'J S X=^(J,0),D=$P(X,"^",2),^TMP("SOWK",$J,LINE)=$$LJ^XLFSTR(SP15_$P(X,"^"),50," ")_"Age: "_($E(DT,1,3)-$E(D,1,3)-($E(D,4,7)>$E(DT,4,7))),LINE=LINE+1
- S ^TMP("SOWK",$J,LINE)=" 4. Describe Social Support System:",LINE=LINE+1
- K ^UTILITY($J,"W") S DIWL=0,DIWF="C60" F J=0:0 S J=$O(^SOWK(655.2,DFN,13,J)) Q:'J S X=^(J,0) D ^DIWP
- F J=0:0 S J=$O(^UTILITY($J,"W",0,J)) Q:'J S X=^(J,0),^TMP("SOWK",$J,LINE)=SP10_X,LINE=LINE+1
- S ^TMP("SOWK",$J,LINE)=" 5. Present Use of Community Resources:",LINE=LINE+1
- K ^UTILITY($J,"W") F J=0:0 S J=$O(^SOWK(655.2,DFN,14,J)) Q:'J S X=^(J,0) D ^DIWP
- F J=0:0 S J=$O(^UTILITY($J,"W",0,J)) Q:'J S X=^(J,0),^TMP("SOWK",$J,LINE)=SP10_X,LINE=LINE+1
- S Y=$P(^SOWK(655.2,DFN,0),"^",15),C=$P(^DD(655.2,15,0),"^",2) D Y^DIQ S:Y="" Y="UNSPECIFIED"
- S ^TMP("SOWK",$J,LINE)=" 6. Current Living Arrangements: "_Y,LINE=LINE+1
- S ^TMP("SOWK",$J,LINE)=" 7. Social/Family Assessment:",LINE=LINE+1
- K ^UTILITY($J,"W") F J=0:0 S J=$O(^SOWK(655.2,DFN,16,J)) Q:'J S X=^(J,0) D ^DIWP
- F J=0:0 S J=$O(^UTILITY($J,"W",0,J)) Q:'J S X=^(J,0),^TMP("SOWK",$J,LINE)=SP10_X,LINE=LINE+1
- S ^TMP("SOWK",$J,LINE)="",LINE=LINE+1
- S SO=$P(^SOWK(655.2,DFN,0),"^",25),SO=$S(SO=1:"YES",SO=2:"NO",1:"UNKNOWN"),^TMP("SOWK",$J,LINE)="Current Substance Problems: "_SO,LINE=LINE+1
- S ^TMP("SOWK",$J,LINE)="",LINE=LINE+1
- S ^TMP("SOWK",$J,LINE)=" Comments on Substance Abuse :",LINE=LINE+1
- K ^UTILITY($J,"W") F J=0:0 S J=$O(^SOWK(655.2,DFN,8,J)) Q:'J S X=^(J,0) D ^DIWP
- F J=0:0 S J=$O(^UTILITY($J,"W",0,J)) Q:'J S X=^(J,0),^TMP("SOWK",$J,LINE)=SP10_X,LINE=LINE+1
- S ^TMP("SOWK",$J,LINE)="",LINE=LINE+1
- S ^TMP("SOWK",$J,LINE)="Psycho-Social Assessment:",LINE=LINE+1
- K ^UTILITY($J,"W") F J=0:0 S J=$O(^SOWK(655.2,DFN,19,J)) Q:'J S X=^(J,0) D ^DIWP
- F J=0:0 S J=$O(^UTILITY($J,"W",0,J)) Q:'J S X=^(J,0),^TMP("SOWK",$J,LINE)=SP10_X,LINE=LINE+1
- GMTSSOWZ ;SLC/SBW - Social Work extract comp. in HS namespace ;21/OCT/94
- +1 ;;2.7;Health Summary;;Oct 20, 1995
- SOWKHSUM ; B'ham ISC/DMA - health summary ; 19 Jul 94 / 8:30 AM
- +1 ;;3.0; Social Work ;;27 Apr 93
- +2 ;;
- +3 ;Called with DFN - assumed to be valid
- +4 ;returns parts V. VII. and VIII. of the assessment
- +5 ;in ^TMP("SOWK",$J,line number)
- +6 ;
- +7 NEW LINE,SP15,MS,SP,J,C,Y,X,SO,SP10,SZ,D,DIWL,DIWF
- +8 KILL ^TMP("SOWK",$JOB)
- IF '$DATA(^SOWK(655.2,DFN,0))
- QUIT
- SET LINE=6
- SET $PIECE(SP15," ",15)=""
- SET SP10=$EXTRACT(SP15,1,10)
- +9 SET MS=$PIECE($GET(^DIC(11,+$PIECE(^DPT(DFN,0),"^",5),0)),"^")
- +10 SET ^TMP("SOWK",$JOB,1)="Source of Referral: "_$PIECE(^SOWK(655.2,DFN,0),"^",21)
- +11 SET ^TMP("SOWK",$JOB,2)="Source of Information: "_$SELECT($DATA(^SOWK(655.2,DFN,18)):$PIECE(^(18),"^"),1:"UNSPECIFIED")
- +12 SET ^TMP("SOWK",$JOB,3)="Social/Family Relationship:"
- SET ^(4)=" 1. Marital status: "_MS
- SET ^(5)=" 2. Spouse:"
- +13 SET SP=$GET(^SOWK(655.2,DFN,6))
- +14 FOR J=1:1:4
- IF $PIECE(SP,"^",J)]""
- SET ^TMP("SOWK",$JOB,LINE)=SP15_$PIECE(SP,"^",J)
- SET LINE=LINE+1
- +15 IF $PIECE(SP,"^",5)]""
- SET SZ=$PIECE(^DIC(5,+$PIECE(SP,"^",5),0),"^")_" "_$PIECE(SP,"^",6)
- SET ^(LINE-1)=^TMP("SOWK",$JOB,LINE-1)_", "_SZ
- +16 SET ^TMP("SOWK",$JOB,LINE)=" 3. Children:"
- SET LINE=LINE+1
- +17 FOR J=0:0
- SET J=$ORDER(^SOWK(655.2,DFN,7,J))
- IF 'J
- QUIT
- SET X=^(J,0)
- SET D=$PIECE(X,"^",2)
- SET ^TMP("SOWK",$JOB,LINE)=$$LJ^XLFSTR(SP15_$PIECE(X,"^"),50," ")_"Age: "_($EXTRACT(DT,1,3)-$EXTRACT(D,1,3)-($EXTRACT(D,4,7)>$EXTRACT(DT,4,7)))
- SET LINE=LINE+1
- +18 SET ^TMP("SOWK",$JOB,LINE)=" 4. Describe Social Support System:"
- SET LINE=LINE+1
- +19 KILL ^UTILITY($JOB,"W")
- SET DIWL=0
- SET DIWF="C60"
- FOR J=0:0
- SET J=$ORDER(^SOWK(655.2,DFN,13,J))
- IF 'J
- QUIT
- SET X=^(J,0)
- DO ^DIWP
- +20 FOR J=0:0
- SET J=$ORDER(^UTILITY($JOB,"W",0,J))
- IF 'J
- QUIT
- SET X=^(J,0)
- SET ^TMP("SOWK",$JOB,LINE)=SP10_X
- SET LINE=LINE+1
- +21 SET ^TMP("SOWK",$JOB,LINE)=" 5. Present Use of Community Resources:"
- SET LINE=LINE+1
- +22 KILL ^UTILITY($JOB,"W")
- FOR J=0:0
- SET J=$ORDER(^SOWK(655.2,DFN,14,J))
- IF 'J
- QUIT
- SET X=^(J,0)
- DO ^DIWP
- +23 FOR J=0:0
- SET J=$ORDER(^UTILITY($JOB,"W",0,J))
- IF 'J
- QUIT
- SET X=^(J,0)
- SET ^TMP("SOWK",$JOB,LINE)=SP10_X
- SET LINE=LINE+1
- +24 SET Y=$PIECE(^SOWK(655.2,DFN,0),"^",15)
- SET C=$PIECE(^DD(655.2,15,0),"^",2)
- DO Y^DIQ
- IF Y=""
- SET Y="UNSPECIFIED"
- +25 SET ^TMP("SOWK",$JOB,LINE)=" 6. Current Living Arrangements: "_Y
- SET LINE=LINE+1
- +26 SET ^TMP("SOWK",$JOB,LINE)=" 7. Social/Family Assessment:"
- SET LINE=LINE+1
- +27 KILL ^UTILITY($JOB,"W")
- FOR J=0:0
- SET J=$ORDER(^SOWK(655.2,DFN,16,J))
- IF 'J
- QUIT
- SET X=^(J,0)
- DO ^DIWP
- +28 FOR J=0:0
- SET J=$ORDER(^UTILITY($JOB,"W",0,J))
- IF 'J
- QUIT
- SET X=^(J,0)
- SET ^TMP("SOWK",$JOB,LINE)=SP10_X
- SET LINE=LINE+1
- +29 SET ^TMP("SOWK",$JOB,LINE)=""
- SET LINE=LINE+1
- +30 SET SO=$PIECE(^SOWK(655.2,DFN,0),"^",25)
- SET SO=$SELECT(SO=1:"YES",SO=2:"NO",1:"UNKNOWN")
- SET ^TMP("SOWK",$JOB,LINE)="Current Substance Problems: "_SO
- SET LINE=LINE+1
- +31 SET ^TMP("SOWK",$JOB,LINE)=""
- SET LINE=LINE+1
- +32 SET ^TMP("SOWK",$JOB,LINE)=" Comments on Substance Abuse :"
- SET LINE=LINE+1
- +33 KILL ^UTILITY($JOB,"W")
- FOR J=0:0
- SET J=$ORDER(^SOWK(655.2,DFN,8,J))
- IF 'J
- QUIT
- SET X=^(J,0)
- DO ^DIWP
- +34 FOR J=0:0
- SET J=$ORDER(^UTILITY($JOB,"W",0,J))
- IF 'J
- QUIT
- SET X=^(J,0)
- SET ^TMP("SOWK",$JOB,LINE)=SP10_X
- SET LINE=LINE+1
- +35 SET ^TMP("SOWK",$JOB,LINE)=""
- SET LINE=LINE+1
- +36 SET ^TMP("SOWK",$JOB,LINE)="Psycho-Social Assessment:"
- SET LINE=LINE+1
- +37 KILL ^UTILITY($JOB,"W")
- FOR J=0:0
- SET J=$ORDER(^SOWK(655.2,DFN,19,J))
- IF 'J
- QUIT
- SET X=^(J,0)
- DO ^DIWP
- +38 FOR J=0:0
- SET J=$ORDER(^UTILITY($JOB,"W",0,J))
- IF 'J
- QUIT
- SET X=^(J,0)
- SET ^TMP("SOWK",$JOB,LINE)=SP10_X
- SET LINE=LINE+1
