- DGPTLMU6 ;ALB/MTC - PTF A/P LIST MANAGER UTILITY CONT. ; 9-24-92
- ;;5.3;Registration;**606**;Aug 13, 1993
- ;
- DI501 ;-- this function will load the 501 information into the display array
- N X,Y,I,J
- S I=0 F S I=$O(^DGPT(DGPTF,"M",I)) Q:'I D
- . S X1="",X=$G(^DGPT(DGPTF,"M",I,0)) Q:X']""
- . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=""
- . S Y="Movement Dt :"_$S($P(X,U,10):$$FTIME^VALM1($P(X,U,10)),1:"")
- . S X1=$$SETSTR^VALM1(Y,X1,1,40)
- . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
- . S Y="Treated for SC condit :"_$S($P(X,U,18)=1:"YES",1:"NO")
- . S X1=$$SETSTR^VALM1(Y,X1,1,40)
- . S Y="Treated for AO condit :"_$S($P(X,U,26)=1:"YES",1:"NO")
- . S X1=$$SETSTR^VALM1(Y,X1,45,30)
- . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
- . S Y="Treated for IR condit :"_$S($P(X,U,27)=1:"YES",1:"NO")
- . S X1=$$SETSTR^VALM1(Y,X1,1,40)
- . S Y="Treated for EC condit :"_$S($P(X,U,28)=1:"YES",1:"NO")
- . S X1=$$SETSTR^VALM1(Y,X1,45,30)
- . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
- . S Y="Leave Days :"_$S($P(X,U,3):$P(X,U,3),1:"")
- . S X1=$$SETSTR^VALM1(Y,X1,1,40)
- . S Y="Pass Days :"_$S($P(X,U,4):$P(X,U,4),1:"")
- . S X1=$$SETSTR^VALM1(Y,X1,45,30)
- . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
- . S Y="Losing Specialty :"_$S($P(X,U,2):$P(^DIC(42.4,$P(X,U,2),0),U),1:"")
- . S X1=$$SETSTR^VALM1(Y,X1,1,75)
- . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
- .;
- .;-- check for ICD codes
- . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)="ICD CODES :"
- . F J=5:1:9,11:1:15 I $P(X,U,J) D
- .. S Y=$$ICDDX^ICDCODE($P(X,U,J),$P(X,U,10)),Y=$P(Y,U,2)_" - "_$P(Y,U,4)
- .. S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=" "_Y
- .;
- .;-- check for 300 node information
- .;
- . S X2=$G(^DGPT(DGPTF,"M",I,300)) I X2]"" D DI300^DGPTLMU4(X2)
- Q
- ;
- DI535 ;-- this function will load the 535 information
- N Y,X,X1,DG535
- S DG535=0 F S DG535=$O(^DGPT(DGPTF,535,DG535)) Q:'DG535 D
- . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=""
- . S X=$G(^DGPT(DGPTF,535,DG535,0)),X1=""
- . S Y="Ward Movement Date :"_$S($P(X,U,10):$$FTIME^VALM1($P(X,U,10)),1:"")
- . S X1=$$SETSTR^VALM1(Y,X1,1,40)
- . S Y="Losing Ward Specialty :"_$P(^DIC(42.4,$P(X,U,2),0),U,1)
- . S X1=$$SETSTR^VALM1(Y,X1,45,30)
- . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
- . S Y="Leave Days : "_$P(X,U,3)
- . S X1=$$SETSTR^VALM1(Y,X1,1,40)
- . S Y="Pass Days :"_$P(X,U,4)
- . S X1=$$SETSTR^VALM1(Y,X1,45,30)
- . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
- . S Y="Losing Ward : "_$P(^DIC(42,$P(X,U,6),0),U)
- . S X1=$$SETSTR^VALM1(Y,X1,1,40)
- . S ^TMP("ARCPTFDI",$J,$$NUM^DGPTLMU4(.NUMREC),0)=X1,X1=""
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTLMU6 2693 printed Mar 13, 2025@21:57:36 Page 2
- DGPTLMU6 ;ALB/MTC - PTF A/P LIST MANAGER UTILITY CONT. ; 9-24-92
- +1 ;;5.3;Registration;**606**;Aug 13, 1993
- +2 ;
- DI501 ;-- this function will load the 501 information into the display array
- +1 NEW X,Y,I,J
- +2 SET I=0
- FOR
- SET I=$ORDER(^DGPT(DGPTF,"M",I))
- if 'I
- QUIT
- Begin DoDot:1
- +3 SET X1=""
- SET X=$GET(^DGPT(DGPTF,"M",I,0))
- if X']""
- QUIT
- +4 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=""
- +5 SET Y="Movement Dt :"_$SELECT($PIECE(X,U,10):$$FTIME^VALM1($PIECE(X,U,10)),1:"")
- +6 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
- +7 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=X1
- SET X1=""
- +8 SET Y="Treated for SC condit :"_$SELECT($PIECE(X,U,18)=1:"YES",1:"NO")
- +9 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
- +10 SET Y="Treated for AO condit :"_$SELECT($PIECE(X,U,26)=1:"YES",1:"NO")
- +11 SET X1=$$SETSTR^VALM1(Y,X1,45,30)
- +12 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=X1
- SET X1=""
- +13 SET Y="Treated for IR condit :"_$SELECT($PIECE(X,U,27)=1:"YES",1:"NO")
- +14 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
- +15 SET Y="Treated for EC condit :"_$SELECT($PIECE(X,U,28)=1:"YES",1:"NO")
- +16 SET X1=$$SETSTR^VALM1(Y,X1,45,30)
- +17 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=X1
- SET X1=""
- +18 SET Y="Leave Days :"_$SELECT($PIECE(X,U,3):$PIECE(X,U,3),1:"")
- +19 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
- +20 SET Y="Pass Days :"_$SELECT($PIECE(X,U,4):$PIECE(X,U,4),1:"")
- +21 SET X1=$$SETSTR^VALM1(Y,X1,45,30)
- +22 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=X1
- SET X1=""
- +23 SET Y="Losing Specialty :"_$SELECT($PIECE(X,U,2):$PIECE(^DIC(42.4,$PIECE(X,U,2),0),U),1:"")
- +24 SET X1=$$SETSTR^VALM1(Y,X1,1,75)
- +25 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=X1
- SET X1=""
- +26 ;
- +27 ;-- check for ICD codes
- +28 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)="ICD CODES :"
- +29 FOR J=5:1:9,11:1:15
- IF $PIECE(X,U,J)
- Begin DoDot:2
- +30 SET Y=$$ICDDX^ICDCODE($PIECE(X,U,J),$PIECE(X,U,10))
- SET Y=$PIECE(Y,U,2)_" - "_$PIECE(Y,U,4)
- +31 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=" "_Y
- End DoDot:2
- +32 ;
- +33 ;-- check for 300 node information
- +34 ;
- +35 SET X2=$GET(^DGPT(DGPTF,"M",I,300))
- IF X2]""
- DO DI300^DGPTLMU4(X2)
- End DoDot:1
- +36 QUIT
- +37 ;
- DI535 ;-- this function will load the 535 information
- +1 NEW Y,X,X1,DG535
- +2 SET DG535=0
- FOR
- SET DG535=$ORDER(^DGPT(DGPTF,535,DG535))
- if 'DG535
- QUIT
- Begin DoDot:1
- +3 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=""
- +4 SET X=$GET(^DGPT(DGPTF,535,DG535,0))
- SET X1=""
- +5 SET Y="Ward Movement Date :"_$SELECT($PIECE(X,U,10):$$FTIME^VALM1($PIECE(X,U,10)),1:"")
- +6 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
- +7 SET Y="Losing Ward Specialty :"_$PIECE(^DIC(42.4,$PIECE(X,U,2),0),U,1)
- +8 SET X1=$$SETSTR^VALM1(Y,X1,45,30)
- +9 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=X1
- SET X1=""
- +10 SET Y="Leave Days : "_$PIECE(X,U,3)
- +11 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
- +12 SET Y="Pass Days :"_$PIECE(X,U,4)
- +13 SET X1=$$SETSTR^VALM1(Y,X1,45,30)
- +14 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=X1
- SET X1=""
- +15 SET Y="Losing Ward : "_$PIECE(^DIC(42,$PIECE(X,U,6),0),U)
- +16 SET X1=$$SETSTR^VALM1(Y,X1,1,40)
- +17 SET ^TMP("ARCPTFDI",$JOB,$$NUM^DGPTLMU4(.NUMREC),0)=X1
- SET X1=""
- End DoDot:1
- +18 QUIT
- +19 ;
